From ba35025f231157e9b0fb252cb8f890d6a7efe55f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 5 Nov 2020 14:43:47 +0100 Subject: [PATCH 01/12] Fix metispart in case !HAVE_METIS --- util/psb_metispart_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 081d1bc1..8a928b84 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -77,7 +77,7 @@ module psb_metispart_mod integer(psb_lpk_), intent(in) :: n, nparts integer(psb_lpk_), intent(in) :: ja(:), irp(:) integer(psb_lpk_), allocatable, intent(inout) :: vect(:) -#if defined(METIS_REAL_32) +#if defined(METIS_REAL_32) || !defined(HAVE_METIS) real(psb_spk_),optional, intent(in) :: weights(:) #elif defined(METIS_REAL_64) real(psb_dpk_),optional, intent(in) :: weights(:) @@ -186,7 +186,7 @@ contains type(psb_ld_csr_sparse_mat), intent(in) :: a integer(psb_lpk_) :: nparts real(psb_dpk_), optional :: weights(:) -#if defined(METIS_REAL_32) +#if defined(METIS_REAL_32) || !defined(HAVE_METIS) real(psb_spk_), allocatable :: wgh_(:) #elif defined(METIS_REAL_64) real(psb_dpk_), allocatable :: wgh_(:) @@ -230,7 +230,7 @@ contains type(psb_lz_csr_sparse_mat), intent(in) :: a integer(psb_lpk_) :: nparts real(psb_dpk_), optional :: weights(:) -#if defined(METIS_REAL_32) +#if defined(METIS_REAL_32) || !defined(HAVE_METIS) real(psb_spk_), allocatable :: wgh_(:) #elif defined(METIS_REAL_64) real(psb_dpk_), allocatable :: wgh_(:) @@ -291,7 +291,7 @@ contains type(psb_lc_csr_sparse_mat), intent(in) :: a integer(psb_lpk_) :: nparts real(psb_spk_), optional :: weights(:) -#if defined(METIS_REAL_32) +#if defined(METIS_REAL_32) || !defined(HAVE_METIS) real(psb_spk_), allocatable :: wgh_(:) #elif defined(METIS_REAL_64) real(psb_dpk_), allocatable :: wgh_(:) @@ -319,7 +319,7 @@ contains type(psb_ls_csr_sparse_mat), intent(in) :: a integer(psb_lpk_) :: nparts real(psb_spk_), optional :: weights(:) -#if defined(METIS_REAL_32) +#if defined(METIS_REAL_32) || !defined(HAVE_METIS) real(psb_spk_), allocatable :: wgh_(:) #elif defined(METIS_REAL_64) real(psb_dpk_), allocatable :: wgh_(:) From 2697fbe73a3c23b9b3dd167a3bf4ca1deb556e9d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 13 Nov 2020 14:05:49 +0100 Subject: [PATCH 02/12] Started work on encapsulating CONTEXT. --- base/modules/Makefile | 9 +- base/modules/penv/psi_comm_buffers_mod.F90 | 616 -------------- base/modules/penv/psi_penv_mod.F90 | 906 +++++++++++++++++---- 3 files changed, 745 insertions(+), 786 deletions(-) delete mode 100644 base/modules/penv/psi_comm_buffers_mod.F90 diff --git a/base/modules/Makefile b/base/modules/Makefile index 6c19b247..238ab9ca 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -8,7 +8,7 @@ BASIC_MODS= psb_const_mod.o psb_cbind_const_mod.o psb_error_mod.o psb_realloc_mo auxil/psb_c_realloc_mod.o \ auxil/psb_z_realloc_mod.o -COMMINT=penv/psi_comm_buffers_mod.o penv/psi_penv_mod.o \ +COMMINT=penv/psi_penv_mod.o \ penv/psi_p2p_mod.o penv/psi_m_p2p_mod.o \ penv/psi_e_p2p_mod.o \ penv/psi_s_p2p_mod.o \ @@ -129,7 +129,6 @@ psb_realloc_mod.o \ auxil/psb_z_realloc_mod.o: psb_error_mod.o $(UTIL_MODS): $(BASIC_MODS) -penv/psi_penv_mod.o: penv/psi_comm_buffers_mod.o serial/psb_vect_mod.o serial/psb_mat_mod.o penv/psi_collective_mod.o penv/psi_p2p_mod.o: penv/psi_penv_mod.o psb_realloc_mod.o: auxil/psb_m_realloc_mod.o \ @@ -161,7 +160,7 @@ penv/psi_d_collective_mod.o penv/psi_c_collective_mod.o penv/psi_z_collective_m penv/psi_d_p2p_mod.o penv/psi_c_p2p_mod.o penv/psi_z_p2p_mod.o -auxil/psb_string_mod.o desc/psb_desc_const_mod.o psi_comm_buffers_mod.o: psb_const_mod.o +auxil/psb_string_mod.o desc/psb_desc_const_mod.o psi_penv_mod.o: psb_const_mod.o desc/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o desc/psb_desc_const_mod.o auxil/psb_i_sort_mod.o auxil/psb_s_sort_mod.o auxil/psb_d_sort_mod.o auxil/psb_c_sort_mod.o auxil/psb_z_sort_mod.o \ auxil/psb_ip_reord_mod.o auxil/psi_serial_mod.o auxil/psb_sort_mod.o: $(BASIC_MODS) @@ -353,8 +352,8 @@ penv/psi_penv_mod.o: penv/psi_penv_mod.F90 $(BASIC_MODS) serial/psb_vect_mod.o psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS) $(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@ -penv/psi_comm_buffers_mod.o: penv/psi_comm_buffers_mod.F90 $(BASIC_MODS) - $(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@ +#penv/psi_comm_buffers_mod.o: penv/psi_comm_buffers_mod.F90 $(BASIC_MODS) +# $(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@ penv/psi_p2p_mod.o: penv/psi_p2p_mod.F90 $(BASIC_MODS) $(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@ diff --git a/base/modules/penv/psi_comm_buffers_mod.F90 b/base/modules/penv/psi_comm_buffers_mod.F90 deleted file mode 100644 index c9c484e8..00000000 --- a/base/modules/penv/psi_comm_buffers_mod.F90 +++ /dev/null @@ -1,616 +0,0 @@ -! -! Parallel Sparse BLAS version 3.5 -! (C) Copyright 2006-2018 -! Salvatore Filippone -! Alfredo Buttari -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the PSBLAS group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -#if defined(SERIAL_MPI) -! Provide a fake mpi module just to keep the compiler(s) happy. -module mpi - use psb_const_mod - integer(psb_mpk_), parameter :: mpi_success = 0 - integer(psb_mpk_), parameter :: mpi_request_null = 0 - integer(psb_mpk_), parameter :: mpi_status_size = 1 - integer(psb_mpk_), parameter :: mpi_integer = 1 - integer(psb_mpk_), parameter :: mpi_integer8 = 2 - integer(psb_mpk_), parameter :: mpi_real = 3 - integer(psb_mpk_), parameter :: mpi_double_precision = 4 - integer(psb_mpk_), parameter :: mpi_complex = 5 - integer(psb_mpk_), parameter :: mpi_double_complex = 6 - integer(psb_mpk_), parameter :: mpi_character = 7 - integer(psb_mpk_), parameter :: mpi_logical = 8 - integer(psb_mpk_), parameter :: mpi_integer2 = 9 - integer(psb_mpk_), parameter :: mpi_comm_null = -1 - integer(psb_mpk_), parameter :: mpi_comm_world = 1 - - real(psb_dpk_), external :: mpi_wtime -end module mpi -#endif - -module psi_comm_buffers_mod - use psb_const_mod - - integer(psb_mpk_), parameter:: psb_int_tag = 543987 - integer(psb_mpk_), parameter:: psb_real_tag = psb_int_tag + 1 - integer(psb_mpk_), parameter:: psb_double_tag = psb_real_tag + 1 - integer(psb_mpk_), parameter:: psb_complex_tag = psb_double_tag + 1 - integer(psb_mpk_), parameter:: psb_dcomplex_tag = psb_complex_tag + 1 - integer(psb_mpk_), parameter:: psb_logical_tag = psb_dcomplex_tag + 1 - integer(psb_mpk_), parameter:: psb_char_tag = psb_logical_tag + 1 - integer(psb_mpk_), parameter:: psb_int8_tag = psb_char_tag + 1 - integer(psb_mpk_), parameter:: psb_int2_tag = psb_int8_tag + 1 - integer(psb_mpk_), parameter:: psb_int4_tag = psb_int2_tag + 1 - integer(psb_mpk_), parameter:: psb_long_tag = psb_int4_tag + 1 - - integer(psb_mpk_), parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_double_swap_tag = psb_double_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_complex_swap_tag = psb_complex_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_dcomplex_swap_tag = psb_dcomplex_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_logical_swap_tag = psb_logical_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_char_swap_tag = psb_char_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_int4_swap_tag = psb_int4_tag + psb_int_tag - integer(psb_mpk_), parameter:: psb_long_swap_tag = psb_long_tag + psb_int_tag - - - - integer(psb_mpk_), private, parameter:: psb_int_type = 987543 - integer(psb_mpk_), private, parameter:: psb_real_type = psb_int_type + 1 - integer(psb_mpk_), private, parameter:: psb_double_type = psb_real_type + 1 - integer(psb_mpk_), private, parameter:: psb_complex_type = psb_double_type + 1 - integer(psb_mpk_), private, parameter:: psb_dcomplex_type = psb_complex_type + 1 - integer(psb_mpk_), private, parameter:: psb_logical_type = psb_dcomplex_type + 1 - integer(psb_mpk_), private, parameter:: psb_char_type = psb_logical_type + 1 - integer(psb_mpk_), private, parameter:: psb_int8_type = psb_char_type + 1 - integer(psb_mpk_), private, parameter:: psb_int2_type = psb_int8_type + 1 - integer(psb_mpk_), private, parameter:: psb_int4_type = psb_int2_type + 1 - integer(psb_mpk_), private, parameter:: psb_long_type = psb_int4_type + 1 - - - type psb_buffer_node - integer(psb_mpk_) :: request - integer(psb_mpk_) :: icontxt - integer(psb_mpk_) :: buffer_type - integer(psb_epk_), allocatable :: int8buf(:) - integer(psb_i2pk_), allocatable :: int2buf(:) - integer(psb_mpk_), allocatable :: int4buf(:) - real(psb_spk_), allocatable :: realbuf(:) - real(psb_dpk_), allocatable :: doublebuf(:) - complex(psb_spk_), allocatable :: complexbuf(:) - complex(psb_dpk_), allocatable :: dcomplbuf(:) - logical, allocatable :: logbuf(:) - character(len=1), allocatable :: charbuf(:) - type(psb_buffer_node), pointer :: prev=>null(), next=>null() - end type psb_buffer_node - - type psb_buffer_queue - type(psb_buffer_node), pointer :: head=>null(), tail=>null() - end type psb_buffer_queue - - - interface psi_snd - module procedure& - & psi_msnd, psi_esnd,& - & psi_ssnd, psi_dsnd,& - & psi_csnd, psi_zsnd,& - & psi_logsnd, psi_hsnd,& - & psi_i2snd - end interface - -contains - - subroutine psb_init_queue(mesg_queue,info) - implicit none - type(psb_buffer_queue), intent(inout) :: mesg_queue - integer(psb_ipk_), intent(out) :: info - - info = 0 - if ((.not.associated(mesg_queue%head)).and.& - & (.not.associated(mesg_queue%tail))) then - ! Nothing to do - return - end if - - if ((.not.associated(mesg_queue%head)).or.& - & (.not.associated(mesg_queue%tail))) then - ! If we are here one is associated, the other is not. - ! This is impossible. - info = -1 - write(psb_err_unit,*) 'Wrong status on init ' - return - end if - - end subroutine psb_init_queue - - subroutine psb_wait_buffer(node, info) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - type(psb_buffer_node), intent(inout) :: node - integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: status(mpi_status_size),minfo - minfo = mpi_success - call mpi_wait(node%request,status,minfo) - info=minfo - end subroutine psb_wait_buffer - - subroutine psb_test_buffer(node, flag, info) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - type(psb_buffer_node), intent(inout) :: node - logical, intent(out) :: flag - integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: status(mpi_status_size), minfo - minfo = mpi_success -#if defined(SERIAL_MPI) - flag = .true. -#else - call mpi_test(node%request,flag,status,minfo) -#endif - info=minfo - end subroutine psb_test_buffer - - - subroutine psb_close_context(mesg_queue,icontxt) - type(psb_buffer_queue), intent(inout) :: mesg_queue - integer(psb_mpk_), intent(in) :: icontxt - integer(psb_ipk_) :: info - type(psb_buffer_node), pointer :: node, nextnode - - node => mesg_queue%head - do - if (.not.associated(node)) exit - nextnode => node%next - if (node%icontxt == icontxt) then - call psb_wait_buffer(node,info) - call psb_delete_node(mesg_queue,node) - end if - node => nextnode - end do - end subroutine psb_close_context - - subroutine psb_close_all_context(mesg_queue) - type(psb_buffer_queue), intent(inout) :: mesg_queue - type(psb_buffer_node), pointer :: node, nextnode - integer(psb_ipk_) :: info - - node => mesg_queue%head - do - if (.not.associated(node)) exit - nextnode => node%next - call psb_wait_buffer(node,info) - call psb_delete_node(mesg_queue,node) - node => nextnode - end do - end subroutine psb_close_all_context - - - subroutine psb_delete_node(mesg_queue,node) - type(psb_buffer_queue), intent(inout) :: mesg_queue - type(psb_buffer_node), pointer :: node - type(psb_buffer_node), pointer :: prevnode - - if (.not.associated(node)) then - return - end if - prevnode => node%prev - if (associated(mesg_queue%head,node)) mesg_queue%head => node%next - if (associated(mesg_queue%tail,node)) mesg_queue%tail => prevnode - if (associated(prevnode)) prevnode%next => node%next - if (associated(node%next)) node%next%prev => prevnode - deallocate(node) - - end subroutine psb_delete_node - - subroutine psb_insert_node(mesg_queue,node) - type(psb_buffer_queue), intent(inout) :: mesg_queue - type(psb_buffer_node), pointer :: node - - node%next => null() - node%prev => null() - if ((.not.associated(mesg_queue%head)).and.& - & (.not.associated(mesg_queue%tail))) then - mesg_Queue%head => node - mesg_queue%tail => node - return - end if - mesg_queue%tail%next => node - node%prev => mesg_queue%tail - mesg_queue%tail => node - - end subroutine psb_insert_node - - subroutine psb_test_nodes(mesg_queue) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node, nextnode - integer(psb_ipk_) :: info - logical :: flag - - node => mesg_queue%head - do - if (.not.associated(node)) exit - nextnode => node%next - call psb_test_buffer(node,flag,info) - if (flag) then - call psb_delete_node(mesg_queue,node) - end if - node => nextnode - end do - end subroutine psb_test_nodes - - ! !!!!!!!!!!!!!!!!! - ! - ! Inner send. Basic idea: - ! the input buffer is MOVE_ALLOCed - ! to a node in the mesg queue, then it is sent. - ! Thus the calling process should guarantee that - ! the buffer is dispensable, i.e. the user data - ! has already been copied. - ! - ! !!!!!!!!!!!!!!!!! - subroutine psi_msnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - integer(psb_mpk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_int_type - call move_alloc(buffer,node%int4buf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_msnd - - - subroutine psi_esnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - integer(psb_epk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_int8_type - call move_alloc(buffer,node%int8buf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_esnd - - subroutine psi_i2snd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - integer(psb_i2pk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_int2_type - call move_alloc(buffer,node%int2buf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_i2snd - - subroutine psi_ssnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - real(psb_spk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_real_type - call move_alloc(buffer,node%realbuf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%realbuf,size(node%realbuf),psb_mpi_r_spk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_ssnd - - subroutine psi_dsnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - real(psb_dpk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_double_type - call move_alloc(buffer,node%doublebuf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%doublebuf,size(node%doublebuf),psb_mpi_r_dpk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_dsnd - - subroutine psi_csnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - complex(psb_spk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_complex_type - call move_alloc(buffer,node%complexbuf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%complexbuf,size(node%complexbuf),psb_mpi_c_spk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_csnd - - subroutine psi_zsnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - complex(psb_dpk_), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_dcomplex_type - call move_alloc(buffer,node%dcomplbuf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),psb_mpi_c_dpk_,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_zsnd - - - subroutine psi_logsnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - logical, allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_logical_type - call move_alloc(buffer,node%logbuf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%logbuf,size(node%logbuf),mpi_logical,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_logsnd - - - subroutine psi_hsnd(icontxt,tag,dest,buffer,mesg_queue) -#ifdef MPI_MOD - use mpi -#endif - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - integer(psb_mpk_) :: icontxt, tag, dest - character(len=1), allocatable, intent(inout) :: buffer(:) - type(psb_buffer_queue) :: mesg_queue - type(psb_buffer_node), pointer :: node - integer(psb_ipk_) :: info - integer(psb_mpk_) :: minfo - - allocate(node, stat=info) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - node%icontxt = icontxt - node%buffer_type = psb_char_type - call move_alloc(buffer,node%charbuf) - if (info /= 0) then - write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' - return - end if - call mpi_isend(node%charbuf,size(node%charbuf),mpi_character,& - & dest,tag,icontxt,node%request,minfo) - info = minfo - call psb_insert_node(mesg_queue,node) - - call psb_test_nodes(mesg_queue) - - end subroutine psi_hsnd - - -end module psi_comm_buffers_mod - diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index 4bc18070..65a0a3ac 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -29,9 +29,105 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! +#if defined(SERIAL_MPI) +! Provide a fake mpi module just to keep the compiler(s) happy. +module mpi + use psb_const_mod + integer(psb_mpk_), parameter :: mpi_success = 0 + integer(psb_mpk_), parameter :: mpi_request_null = 0 + integer(psb_mpk_), parameter :: mpi_status_size = 1 + integer(psb_mpk_), parameter :: mpi_integer = 1 + integer(psb_mpk_), parameter :: mpi_integer8 = 2 + integer(psb_mpk_), parameter :: mpi_real = 3 + integer(psb_mpk_), parameter :: mpi_double_precision = 4 + integer(psb_mpk_), parameter :: mpi_complex = 5 + integer(psb_mpk_), parameter :: mpi_double_complex = 6 + integer(psb_mpk_), parameter :: mpi_character = 7 + integer(psb_mpk_), parameter :: mpi_logical = 8 + integer(psb_mpk_), parameter :: mpi_integer2 = 9 + integer(psb_mpk_), parameter :: mpi_comm_null = -1 + integer(psb_mpk_), parameter :: mpi_comm_world = 1 + + real(psb_dpk_), external :: mpi_wtime +end module mpi +#endif + + module psi_penv_mod use psb_const_mod - use psi_comm_buffers_mod, only : psb_buffer_queue + + integer(psb_mpk_), parameter:: psb_int_tag = 543987 + integer(psb_mpk_), parameter:: psb_real_tag = psb_int_tag + 1 + integer(psb_mpk_), parameter:: psb_double_tag = psb_real_tag + 1 + integer(psb_mpk_), parameter:: psb_complex_tag = psb_double_tag + 1 + integer(psb_mpk_), parameter:: psb_dcomplex_tag = psb_complex_tag + 1 + integer(psb_mpk_), parameter:: psb_logical_tag = psb_dcomplex_tag + 1 + integer(psb_mpk_), parameter:: psb_char_tag = psb_logical_tag + 1 + integer(psb_mpk_), parameter:: psb_int8_tag = psb_char_tag + 1 + integer(psb_mpk_), parameter:: psb_int2_tag = psb_int8_tag + 1 + integer(psb_mpk_), parameter:: psb_int4_tag = psb_int2_tag + 1 + integer(psb_mpk_), parameter:: psb_long_tag = psb_int4_tag + 1 + + integer(psb_mpk_), parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_double_swap_tag = psb_double_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_complex_swap_tag = psb_complex_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_dcomplex_swap_tag = psb_dcomplex_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_logical_swap_tag = psb_logical_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_char_swap_tag = psb_char_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_int4_swap_tag = psb_int4_tag + psb_int_tag + integer(psb_mpk_), parameter:: psb_long_swap_tag = psb_long_tag + psb_int_tag + + + + integer(psb_mpk_), private, parameter:: psb_int_type = 987543 + integer(psb_mpk_), private, parameter:: psb_real_type = psb_int_type + 1 + integer(psb_mpk_), private, parameter:: psb_double_type = psb_real_type + 1 + integer(psb_mpk_), private, parameter:: psb_complex_type = psb_double_type + 1 + integer(psb_mpk_), private, parameter:: psb_dcomplex_type = psb_complex_type + 1 + integer(psb_mpk_), private, parameter:: psb_logical_type = psb_dcomplex_type + 1 + integer(psb_mpk_), private, parameter:: psb_char_type = psb_logical_type + 1 + integer(psb_mpk_), private, parameter:: psb_int8_type = psb_char_type + 1 + integer(psb_mpk_), private, parameter:: psb_int2_type = psb_int8_type + 1 + integer(psb_mpk_), private, parameter:: psb_int4_type = psb_int2_type + 1 + integer(psb_mpk_), private, parameter:: psb_long_type = psb_int4_type + 1 + + + type psb_ctxt_type + integer(psb_mpk_), allocatable :: ctxt + end type psb_ctxt_type + + type psb_buffer_node + integer(psb_mpk_) :: request + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: buffer_type + integer(psb_epk_), allocatable :: int8buf(:) + integer(psb_i2pk_), allocatable :: int2buf(:) + integer(psb_mpk_), allocatable :: int4buf(:) + real(psb_spk_), allocatable :: realbuf(:) + real(psb_dpk_), allocatable :: doublebuf(:) + complex(psb_spk_), allocatable :: complexbuf(:) + complex(psb_dpk_), allocatable :: dcomplbuf(:) + logical, allocatable :: logbuf(:) + character(len=1), allocatable :: charbuf(:) + type(psb_buffer_node), pointer :: prev=>null(), next=>null() + end type psb_buffer_node + + type psb_buffer_queue + type(psb_buffer_node), pointer :: head=>null(), tail=>null() + end type psb_buffer_queue + + interface psi_snd + module procedure& + & psi_msnd, psi_esnd,& + & psi_ssnd, psi_dsnd,& + & psi_csnd, psi_zsnd,& + & psi_logsnd, psi_hsnd,& + & psi_i2snd + end interface + interface psb_init module procedure psb_init_mpik @@ -53,36 +149,16 @@ module psi_penv_mod module procedure psb_barrier_mpik end interface - interface psb_init - module procedure psb_init_epk - end interface - - interface psb_exit - module procedure psb_exit_epk - end interface - - interface psb_abort - module procedure psb_abort_epk - end interface - - interface psb_info - module procedure psb_info_epk - end interface - - interface psb_barrier - module procedure psb_barrier_epk - end interface - interface psb_wtime module procedure psb_wtime end interface psb_wtime interface psb_get_mpi_comm - module procedure psb_m_get_mpi_comm, psb_e_get_mpi_comm + module procedure psb_m_get_mpi_comm !, psb_e_get_mpi_comm end interface psb_get_mpi_comm interface psb_get_mpi_rank - module procedure psb_m_get_mpi_rank, psb_e_get_mpi_rank + module procedure psb_m_get_mpi_rank!, psb_e_get_mpi_rank end interface psb_get_mpi_rank #if defined(SERIAL_MPI) @@ -115,6 +191,515 @@ module psi_penv_mod contains + + function psb_cmp_ctxt(ctxt1, ctxt2) result(res) + type(psb_ctxt_type), intent(in) :: ctxt1, ctxt2 + logical :: res + + res = .false. + if (.not.allocated(ctxt1%ctxt).and.(.not.allocated(ctxt2%ctxt))) & + & res = .true. + if (allocated(ctxt1%ctxt).and.allocated(ctxt2%ctxt)) & + & res = (ctxt1%ctxt == ctxt2%ctxt) + + end function psb_cmp_ctxt + + subroutine psb_init_queue(mesg_queue,info) + implicit none + type(psb_buffer_queue), intent(inout) :: mesg_queue + integer(psb_ipk_), intent(out) :: info + + info = 0 + if ((.not.associated(mesg_queue%head)).and.& + & (.not.associated(mesg_queue%tail))) then + ! Nothing to do + return + end if + + if ((.not.associated(mesg_queue%head)).or.& + & (.not.associated(mesg_queue%tail))) then + ! If we are here one is associated, the other is not. + ! This is impossible. + info = -1 + write(psb_err_unit,*) 'Wrong status on init ' + return + end if + + end subroutine psb_init_queue + + subroutine psb_wait_buffer(node, info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_buffer_node), intent(inout) :: node + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: status(mpi_status_size),minfo + minfo = mpi_success + call mpi_wait(node%request,status,minfo) + info=minfo + end subroutine psb_wait_buffer + + subroutine psb_test_buffer(node, flag, info) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_buffer_node), intent(inout) :: node + logical, intent(out) :: flag + integer(psb_ipk_), intent(out) :: info + integer(psb_mpk_) :: status(mpi_status_size), minfo + minfo = mpi_success +#if defined(SERIAL_MPI) + flag = .true. +#else + call mpi_test(node%request,flag,status,minfo) +#endif + info=minfo + end subroutine psb_test_buffer + + + subroutine psb_close_context(mesg_queue,icontxt) + type(psb_buffer_queue), intent(inout) :: mesg_queue + type(psb_ctxt_type), intent(in) :: icontxt + integer(psb_ipk_) :: info + type(psb_buffer_node), pointer :: node, nextnode + + node => mesg_queue%head + do + if (.not.associated(node)) exit + nextnode => node%next + if (psb_cmp_ctxt(node%icontxt,icontxt)) then + call psb_wait_buffer(node,info) + call psb_delete_node(mesg_queue,node) + end if + node => nextnode + end do + end subroutine psb_close_context + + subroutine psb_close_all_context(mesg_queue) + type(psb_buffer_queue), intent(inout) :: mesg_queue + type(psb_buffer_node), pointer :: node, nextnode + integer(psb_ipk_) :: info + + node => mesg_queue%head + do + if (.not.associated(node)) exit + nextnode => node%next + call psb_wait_buffer(node,info) + call psb_delete_node(mesg_queue,node) + node => nextnode + end do + end subroutine psb_close_all_context + + + subroutine psb_delete_node(mesg_queue,node) + type(psb_buffer_queue), intent(inout) :: mesg_queue + type(psb_buffer_node), pointer :: node + type(psb_buffer_node), pointer :: prevnode + + if (.not.associated(node)) then + return + end if + prevnode => node%prev + if (associated(mesg_queue%head,node)) mesg_queue%head => node%next + if (associated(mesg_queue%tail,node)) mesg_queue%tail => prevnode + if (associated(prevnode)) prevnode%next => node%next + if (associated(node%next)) node%next%prev => prevnode + deallocate(node) + + end subroutine psb_delete_node + + subroutine psb_insert_node(mesg_queue,node) + type(psb_buffer_queue), intent(inout) :: mesg_queue + type(psb_buffer_node), pointer :: node + + node%next => null() + node%prev => null() + if ((.not.associated(mesg_queue%head)).and.& + & (.not.associated(mesg_queue%tail))) then + mesg_Queue%head => node + mesg_queue%tail => node + return + end if + mesg_queue%tail%next => node + node%prev => mesg_queue%tail + mesg_queue%tail => node + + end subroutine psb_insert_node + + subroutine psb_test_nodes(mesg_queue) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node, nextnode + integer(psb_ipk_) :: info + logical :: flag + + node => mesg_queue%head + do + if (.not.associated(node)) exit + nextnode => node%next + call psb_test_buffer(node,flag,info) + if (flag) then + call psb_delete_node(mesg_queue,node) + end if + node => nextnode + end do + end subroutine psb_test_nodes + + ! !!!!!!!!!!!!!!!!! + ! + ! Inner send. Basic idea: + ! the input buffer is MOVE_ALLOCed + ! to a node in the mesg queue, then it is sent. + ! Thus the calling process should guarantee that + ! the buffer is dispensable, i.e. the user data + ! has already been copied. + ! + ! !!!!!!!!!!!!!!!!! + subroutine psi_msnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + integer(psb_mpk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_int_type + call move_alloc(buffer,node%int4buf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,& + & dest,tag,icontxt,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + + call psb_test_nodes(mesg_queue) + + end subroutine psi_msnd + + + subroutine psi_esnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + integer(psb_epk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_int8_type + call move_alloc(buffer,node%int8buf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_esnd + + subroutine psi_i2snd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + integer(psb_i2pk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_int2_type + call move_alloc(buffer,node%int2buf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_i2snd + + subroutine psi_ssnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + real(psb_spk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_real_type + call move_alloc(buffer,node%realbuf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%realbuf,size(node%realbuf),psb_mpi_r_spk_,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_ssnd + + subroutine psi_dsnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + real(psb_dpk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_double_type + call move_alloc(buffer,node%doublebuf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%doublebuf,size(node%doublebuf),psb_mpi_r_dpk_,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_dsnd + + subroutine psi_csnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + complex(psb_spk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_complex_type + call move_alloc(buffer,node%complexbuf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%complexbuf,size(node%complexbuf),psb_mpi_c_spk_,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_csnd + + subroutine psi_zsnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + complex(psb_dpk_), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_dcomplex_type + call move_alloc(buffer,node%dcomplbuf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),psb_mpi_c_dpk_,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_zsnd + + + subroutine psi_logsnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + logical, allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_logical_type + call move_alloc(buffer,node%logbuf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%logbuf,size(node%logbuf),mpi_logical,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_logsnd + + + subroutine psi_hsnd(icontxt,tag,dest,buffer,mesg_queue) +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + type(psb_ctxt_type) :: icontxt + integer(psb_mpk_) :: tag, dest + character(len=1), allocatable, intent(inout) :: buffer(:) + type(psb_buffer_queue) :: mesg_queue + type(psb_buffer_node), pointer :: node + integer(psb_ipk_) :: info + integer(psb_mpk_) :: minfo, icomm + + allocate(node, stat=info) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + node%icontxt = icontxt + icomm = psb_get_mpi_comm(icontxt) + node%buffer_type = psb_char_type + call move_alloc(buffer,node%charbuf) + if (info /= 0) then + write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' + return + end if + call mpi_isend(node%charbuf,size(node%charbuf),mpi_character,& + & dest,tag,icomm,node%request,minfo) + info = minfo + call psb_insert_node(mesg_queue,node) + call psb_test_nodes(mesg_queue) + + end subroutine psi_hsnd + + ! !!!!!!!!!!!!!!!!!!!!!! ! ! Environment handling @@ -207,87 +792,85 @@ contains end subroutine psi_register_mpi_extras - subroutine psb_init_epk(ictxt,np,basectxt,ids) - integer(psb_epk_), intent(out) :: ictxt - integer(psb_epk_), intent(in), optional :: np, basectxt, ids(:) - - integer(psb_mpk_) :: iictxt - integer(psb_mpk_) :: inp, ibasectxt - integer(psb_mpk_), allocatable :: ids_(:) - - if (present(ids)) then - allocate(ids_(size(ids))) - ids_ = ids - else - allocate(ids_(0)) - end if - if (present(np).and.present(basectxt)) then - inp = np - ibasectxt = basectxt - call psb_init(iictxt,np=inp,basectxt=ibasectxt,ids=ids_) - else if (present(np)) then - inp = np - call psb_init(iictxt,np=inp,ids=ids_) - else if (present(basectxt)) then - ibasectxt = basectxt - call psb_init(iictxt,basectxt=ibasectxt,ids=ids_) - else - call psb_init(iictxt,ids=ids_) - end if - ictxt = iictxt - end subroutine psb_init_epk - - subroutine psb_exit_epk(ictxt,close) - integer(psb_epk_), intent(inout) :: ictxt - logical, intent(in), optional :: close - integer(psb_mpk_) :: iictxt - - iictxt = ictxt - call psb_exit(iictxt, close) - end subroutine psb_exit_epk - - subroutine psb_barrier_epk(ictxt) - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_) :: iictxt - - iictxt = ictxt - call psb_barrier(iictxt) - end subroutine psb_barrier_epk - - subroutine psb_abort_epk(ictxt,errc) - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(in), optional :: errc - integer(psb_mpk_) :: 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_epk - - subroutine psb_info_epk(ictxt,iam,np) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: iam, np - - ! - ! Simple caching scheme, keep track - ! of the last CTXT encountered. - ! - integer(psb_mpk_), save :: lctxt=-1, lam, lnp - if (ictxt /= lctxt) then - lctxt = ictxt - call psb_info(lctxt,lam,lnp) - end if - iam = lam - np = lnp - end subroutine psb_info_epk +!!$ subroutine psb_init_epk(ictxt,np,basectxt,ids) +!!$ type(psb_ctxt_type), intent(out) :: ictxt +!!$ integer(psb_epk_), intent(in), optional :: np, basectxt, ids(:) +!!$ +!!$ integer(psb_mpk_) :: iictxt +!!$ integer(psb_mpk_) :: inp, ibasectxt +!!$ integer(psb_mpk_), allocatable :: ids_(:) +!!$ +!!$ if (present(ids)) then +!!$ allocate(ids_(size(ids))) +!!$ ids_ = ids +!!$ else +!!$ allocate(ids_(0)) +!!$ end if +!!$ if (present(np).and.present(basectxt)) then +!!$ inp = np +!!$ ibasectxt = basectxt +!!$ call psb_init(ictxt,np=inp,basectxt=ibasectxt,ids=ids_) +!!$ else if (present(np)) then +!!$ inp = np +!!$ call psb_init(ictxt,np=inp,ids=ids_) +!!$ else if (present(basectxt)) then +!!$ ibasectxt = basectxt +!!$ call psb_init(ictxt,basectxt=ibasectxt,ids=ids_) +!!$ else +!!$ call psb_init(ictxt,ids=ids_) +!!$ end if +!!$ end subroutine psb_init_epk + +!!$ subroutine psb_exit_epk(ictxt,close) +!!$ integer(psb_epk_), intent(inout) :: ictxt +!!$ logical, intent(in), optional :: close +!!$ integer(psb_mpk_) :: iictxt +!!$ +!!$ iictxt = ictxt +!!$ call psb_exit(iictxt, close) +!!$ end subroutine psb_exit_epk +!!$ +!!$ subroutine psb_barrier_epk(ictxt) +!!$ integer(psb_epk_), intent(in) :: ictxt +!!$ integer(psb_mpk_) :: iictxt +!!$ +!!$ iictxt = ictxt +!!$ call psb_barrier(iictxt) +!!$ end subroutine psb_barrier_epk +!!$ +!!$ subroutine psb_abort_epk(ictxt,errc) +!!$ integer(psb_epk_), intent(in) :: ictxt +!!$ integer(psb_epk_), intent(in), optional :: errc +!!$ integer(psb_mpk_) :: 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_epk +!!$ +!!$ subroutine psb_info_epk(ictxt,iam,np) +!!$ +!!$ integer(psb_epk_), intent(in) :: ictxt +!!$ integer(psb_epk_), intent(out) :: iam, np +!!$ +!!$ ! +!!$ ! Simple caching scheme, keep track +!!$ ! of the last CTXT encountered. +!!$ ! +!!$ integer(psb_mpk_), save :: lctxt=-1, lam, lnp +!!$ if (ictxt /= lctxt) then +!!$ lctxt = ictxt +!!$ call psb_info(lctxt,lam,lnp) +!!$ end if +!!$ iam = lam +!!$ np = lnp +!!$ end subroutine psb_info_epk subroutine psb_init_mpik(ictxt,np,basectxt,ids) - use psi_comm_buffers_mod use psb_const_mod use psb_error_mod use psb_mat_mod @@ -300,10 +883,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(out) :: ictxt + type(psb_ctxt_type), intent(out) :: ictxt integer(psb_mpk_), intent(in), optional :: np, basectxt, ids(:) - integer(psb_mpk_) :: i, isnullcomm + integer(psb_mpk_) :: i, isnullcomm, icomm integer(psb_mpk_), allocatable :: iids(:) logical :: initialized integer(psb_mpk_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup @@ -340,7 +923,7 @@ contains iinfo=psb_err_initerror_neugh_procs_ call psb_errpush(iinfo,name) call psb_error() - ictxt = mpi_comm_null + !ictxt = mpi_comm_null return endif call mpi_comm_size(basecomm,np_,info) @@ -348,32 +931,32 @@ contains iinfo=psb_err_initerror_neugh_procs_ call psb_errpush(iinfo,name) call psb_error() - ictxt = mpi_comm_null + !ictxt = mpi_comm_null return endif call mpi_comm_group(basecomm,basegroup,info) if (present(ids)) then if (size(ids)np_)) then write(psb_err_unit,*) 'Error in init: invalid rank in input' - ictxt = mpi_comm_null + !ictxt%ctxt = mpi_comm_null return end if end do call mpi_group_incl(basegroup,np,ids,newgroup,info) if (info /= mpi_success) then - ictxt = mpi_comm_null + !ictxt%ctxt = mpi_comm_null return endif else allocate(iids(np),stat=info) if (info /= 0) then - ictxt = mpi_comm_null + !ictxt%ctxt = mpi_comm_null return endif do i=1, np @@ -381,23 +964,28 @@ contains end do call mpi_group_incl(basegroup,np,iids,newgroup,info) if (info /= mpi_success) then - ictxt = mpi_comm_null + !ictxt = mpi_comm_null return endif deallocate(iids) end if - call mpi_comm_create(basecomm,newgroup,ictxt,info) - + + call mpi_comm_create(basecomm,newgroup,icomm,info) + else if (basecomm /= mpi_comm_null) then - call mpi_comm_dup(basecomm,ictxt,info) + call mpi_comm_dup(basecomm,icomm,info) else - ictxt = mpi_comm_null + ! ictxt = mpi_comm_null end if endif + if (info == 0) then + ictxt%ctxt = icomm ! allocate on assignment + end if call psi_register_mpi_extras(info) call psi_get_sizes() - if (ictxt == mpi_comm_null) return + !if (ictxt == mpi_comm_null) return + if (.not.allocated(ictxt%ctxt)) return #endif call psb_init_vect_defaults() call psb_init_mat_defaults() @@ -417,7 +1005,6 @@ contains end subroutine psb_init_mpik subroutine psb_exit_mpik(ictxt,close) - use psi_comm_buffers_mod use psb_mat_mod use psb_vect_mod ! !$ use psb_rsb_mod @@ -428,7 +1015,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(inout) :: ictxt + type(psb_ctxt_type), intent(inout) :: ictxt logical, intent(in), optional :: close logical :: close_ integer(psb_mpk_) :: info @@ -460,8 +1047,9 @@ contains else call psb_close_context(psb_mesg_queue,ictxt) end if - if ((ictxt /= mpi_comm_null).and.(ictxt /= mpi_comm_world)) then - call mpi_comm_Free(ictxt,info) + !if ((ictxt /= mpi_comm_null).and.(ictxt /= mpi_comm_world)) then + if (allocated(ictxt%ctxt)) then + if (ictxt%ctxt /= mpi_comm_world)call mpi_comm_Free(ictxt%ctxt,info) end if if (close_) call mpi_finalize(info) @@ -481,12 +1069,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_) :: info #if !defined(SERIAL_MPI) - if (ictxt /= mpi_comm_null) then - call mpi_barrier(ictxt, info) + if (allocated(ictxt%ctxt)) then + if (ictxt%ctxt /= mpi_comm_null) call mpi_barrier(ictxt%ctxt, info) end if #endif @@ -508,9 +1096,8 @@ contains end function psb_wtime subroutine psb_abort_mpik(ictxt,errc) - use psi_comm_buffers_mod - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in), optional :: errc integer(psb_mpk_) :: code, info @@ -524,14 +1111,13 @@ contains code = -1 endif - call mpi_abort(ictxt,code,info) + if (allocated(ictxt%ctxt)) call mpi_abort(ictxt%ctxt,code,info) #endif end subroutine psb_abort_mpik subroutine psb_info_mpik(ictxt,iam,np) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -540,7 +1126,7 @@ contains include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(out) :: iam, np integer(psb_mpk_) :: info ! @@ -555,62 +1141,51 @@ contains #else iam = -1 np = -1 - if (ictxt == lctxt) then - iam = lam - np = lnp - else - if (ictxt /= mpi_comm_null) then - call mpi_comm_size(ictxt,np,info) - if (info /= mpi_success) np = -1 - call mpi_comm_rank(ictxt,iam,info) - if (info /= mpi_success) iam = -1 + if (allocated(ictxt%ctxt)) then + if (ictxt%ctxt == lctxt) then + iam = lam + np = lnp + else + if (ictxt%ctxt /= mpi_comm_null) then + call mpi_comm_size(ictxt%ctxt,np,info) + if (info /= mpi_success) np = -1 + call mpi_comm_rank(ictxt%ctxt,iam,info) + if (info /= mpi_success) iam = -1 + end if + lctxt = ictxt%ctxt + lam = iam + lnp = np end if - lctxt = ictxt - lam = iam - lnp = np end if #endif - end subroutine psb_info_mpik function psb_m_get_mpi_comm(ictxt) result(comm) - integer(psb_mpk_) :: ictxt, comm - - comm = ictxt - end function psb_m_get_mpi_comm - - function psb_e_get_mpi_comm(ictxt) result(comm) - integer(psb_epk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_mpk_) :: comm - - comm = ictxt - end function psb_e_get_mpi_comm + comm = mpi_comm_null + if (allocated(ictxt%ctxt)) comm = ictxt%ctxt + end function psb_m_get_mpi_comm function psb_m_get_mpi_rank(ictxt,id) result(rank) integer(psb_mpk_) :: rank - integer(psb_mpk_) :: ictxt,id + integer(psb_mpk_) :: id + type(psb_ctxt_type) :: ictxt rank = id end function psb_m_get_mpi_rank - - function psb_e_get_mpi_rank(ictxt,id) result(rank) - integer(psb_mpk_) :: rank - integer(psb_epk_) :: ictxt,id - - rank = id - end function psb_e_get_mpi_rank - - subroutine psb_get_mpicomm(ictxt,comm) - integer(psb_mpk_) :: ictxt, comm - - comm = psb_get_mpi_comm(ictxt) + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: comm + comm = mpi_comm_null + if (allocated(ictxt%ctxt)) comm = ictxt%ctxt end subroutine psb_get_mpicomm subroutine psb_get_rank(rank,ictxt,id) - integer(psb_mpk_) :: rank,ictxt,id + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: rank,id rank = psb_get_mpi_rank(ictxt,id) end subroutine psb_get_rank @@ -789,4 +1364,5 @@ contains end do end subroutine psi_dnrm2_op + end module psi_penv_mod From 2009ed8dbe8e377ea3cef1fcbd882b7abf4b7f2b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 13 Nov 2020 15:51:20 +0100 Subject: [PATCH 03/12] First round of updateds for new CONTEXT --- base/modules/penv/psi_c_collective_mod.F90 | 354 +++--------- base/modules/penv/psi_c_p2p_mod.F90 | 133 +---- base/modules/penv/psi_collective_mod.F90 | 191 ++----- base/modules/penv/psi_d_collective_mod.F90 | 577 +++++--------------- base/modules/penv/psi_d_p2p_mod.F90 | 133 +---- base/modules/penv/psi_e_collective_mod.F90 | 522 ++++-------------- base/modules/penv/psi_e_p2p_mod.F90 | 133 +---- base/modules/penv/psi_i2_collective_mod.F90 | 522 ++++-------------- base/modules/penv/psi_i2_p2p_mod.F90 | 133 +---- base/modules/penv/psi_m_collective_mod.F90 | 522 ++++-------------- base/modules/penv/psi_m_p2p_mod.F90 | 133 +---- base/modules/penv/psi_p2p_mod.F90 | 165 +----- base/modules/penv/psi_penv_mod.F90 | 42 +- base/modules/penv/psi_s_collective_mod.F90 | 577 +++++--------------- base/modules/penv/psi_s_p2p_mod.F90 | 133 +---- base/modules/penv/psi_z_collective_mod.F90 | 354 +++--------- base/modules/penv/psi_z_p2p_mod.F90 | 133 +---- test/fileread/runs/dfs.inp | 2 +- 18 files changed, 954 insertions(+), 3805 deletions(-) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index a1fa78a3..4f26c8a1 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -31,28 +31,22 @@ ! module psi_c_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_sum - module procedure psb_csums, psb_csumv, psb_csumm, & - & psb_csums_ec, psb_csumv_ec, psb_csumm_ec + module procedure psb_csums, psb_csumv, psb_csumm end interface interface psb_amx - module procedure psb_camxs, psb_camxv, psb_camxm, & - & psb_camxs_ec, psb_camxv_ec, psb_camxm_ec + module procedure psb_camxs, psb_camxv, psb_camxm end interface interface psb_amn - module procedure psb_camns, psb_camnv, psb_camnm, & - & psb_camns_ec, psb_camnv_ec, psb_camnm_ec + module procedure psb_camns, psb_camnv, psb_camnm end interface - interface psb_bcast - module procedure psb_cbcasts, psb_cbcastv, psb_cbcastm, & - & psb_cbcasts_ec, psb_cbcastv_ec, psb_cbcastm_ec + module procedure psb_cbcasts, psb_cbcastv, psb_cbcastm end interface psb_bcast interface psb_scan_sum @@ -71,7 +65,6 @@ module psi_c_collective_mod module procedure psb_c_e_simple_triad_a2av, psb_c_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -94,15 +87,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -111,11 +103,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -130,15 +123,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -147,19 +139,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -174,12 +167,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -191,73 +184,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_csumm - subroutine psb_csums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_csums_ec - - subroutine psb_csumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_csumv_ec - - subroutine psb_csumm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_csumm_ec - - ! ! AMX: Maximum Absolute Value ! @@ -270,15 +215,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -287,11 +231,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -306,15 +251,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -323,19 +267,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) end if endif #endif @@ -350,12 +295,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -367,74 +312,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camx_op,root_,icomm,info) end if endif #endif end subroutine psb_camxm - - subroutine psb_camxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_camxs_ec - - subroutine psb_camxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_camxv_ec - - subroutine psb_camxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_camxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -447,15 +343,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -464,11 +359,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -483,15 +379,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -500,19 +395,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) end if endif #endif @@ -527,12 +423,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -544,74 +440,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_camn_op,root_,icomm,info) end if endif #endif end subroutine psb_camnm - - subroutine psb_camns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_camns_ec - - subroutine psb_camnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_camnv_ec - - subroutine psb_camnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_camnm_ec - - ! ! BCAST Broadcast ! @@ -624,15 +471,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -641,7 +487,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,icomm,info) #endif end subroutine psb_cbcasts @@ -655,14 +502,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -671,8 +517,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info) #endif end subroutine psb_cbcastv @@ -685,12 +531,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -702,61 +548,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info) #endif end subroutine psb_cbcastm - - subroutine psb_cbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_cbcasts_ec - - subroutine psb_cbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_cbcastv_ec - - subroutine psb_cbcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_cbcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -771,13 +567,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -795,7 +590,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -821,7 +616,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -848,7 +643,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -875,9 +670,8 @@ contains complex(psb_spk_), intent(in) :: valsnd(:) complex(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -919,7 +713,7 @@ contains complex(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1002,7 +796,7 @@ contains complex(psb_spk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_c_p2p_mod.F90 b/base/modules/penv/psi_c_p2p_mod.F90 index f732c808..2230f49a 100644 --- a/base/modules/penv/psi_c_p2p_mod.F90 +++ b/base/modules/penv/psi_c_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_c_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_csnds, psb_csndv, psb_csndm, & - & psb_csnds_ec, psb_csndv_ec, psb_csndm_ec + module procedure psb_csnds, psb_csndv, psb_csndm end interface interface psb_rcv - module procedure psb_crcvs, psb_crcvv, psb_crcvm, & - & psb_crcvs_ec, psb_crcvv_ec, psb_crcvm_ec + module procedure psb_crcvs, psb_crcvv, psb_crcvm end interface contains subroutine psb_csnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst complex(psb_spk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_csnds subroutine psb_csndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_csndv subroutine psb_csndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m complex(psb_spk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_csndm subroutine psb_crcvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_crcvs subroutine psb_crcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_crcvv subroutine psb_crcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_spk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m complex(psb_spk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_c_spk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_complex_tag,ictxt,status,info) + & psb_complex_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_crcvm - - subroutine psb_csnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_csnds_ec - - subroutine psb_csndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_csndv_ec - - subroutine psb_csndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_csndm_ec - - subroutine psb_crcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_crcvs_ec - - subroutine psb_crcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_crcvv_ec - - subroutine psb_crcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_spk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_crcvm_ec - - end module psi_c_p2p_mod diff --git a/base/modules/penv/psi_collective_mod.F90 b/base/modules/penv/psi_collective_mod.F90 index 0fb37241..fab751ec 100644 --- a/base/modules/penv/psi_collective_mod.F90 +++ b/base/modules/penv/psi_collective_mod.F90 @@ -40,22 +40,18 @@ module psi_collective_mod interface psb_bcast module procedure psb_hbcasts, psb_hbcastv,& - & psb_hbcasts_ec, psb_hbcastv_ec,& - & psb_lbcasts, psb_lbcastv, & - & psb_lbcasts_ec, psb_lbcastv_ec + & psb_lbcasts, psb_lbcastv end interface psb_bcast #if defined(SHORT_INTEGERS) interface psb_sum - module procedure psb_i2sums, psb_i2sumv, psb_i2summ, & - & psb_i2sums_ec, psb_i2sumv_ec, psb_i2summ_ec + module procedure psb_i2sums, psb_i2sumv, psb_i2summ end interface psb_sum #endif contains - subroutine psb_hbcasts(ictxt,dat,root,length) #ifdef MPI_MOD use mpi @@ -64,11 +60,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt character(len=*), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root,length - integer(psb_mpk_) :: iam, np, root_,length_,info + integer(psb_mpk_) :: iam, np, root_,length_,info, icomm #if !defined(SERIAL_MPI) if (present(root)) then @@ -83,8 +79,8 @@ contains endif call psb_info(ictxt,iam,np) - - call mpi_bcast(dat,length_,MPI_CHARACTER,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,length_,MPI_CHARACTER,root_,icomm,info) #endif end subroutine psb_hbcasts @@ -97,11 +93,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt character(len=*), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: iam, np, root_,length_,info, size_ + integer(psb_mpk_) :: iam, np, root_, icomm + integer(psb_mpk_) :: length_,info, size_ #if !defined(SERIAL_MPI) if (present(root)) then @@ -113,46 +110,12 @@ contains size_ = size(dat) call psb_info(ictxt,iam,np) - - call mpi_bcast(dat,length_*size_,MPI_CHARACTER,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,length_*size_,MPI_CHARACTER,root_,icomm,info) #endif end subroutine psb_hbcastv - subroutine psb_hbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - character(len=*), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_hbcasts_ec - - subroutine psb_hbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - character(len=*), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_hbcastv_ec - - - subroutine psb_lbcasts(ictxt,dat,root) #ifdef MPI_MOD use mpi @@ -161,11 +124,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: iam, np, root_,info + integer(psb_mpk_) :: iam, np, root_,info, icomm #if !defined(SERIAL_MPI) if (present(root)) then @@ -175,7 +138,8 @@ contains endif call psb_info(ictxt,iam,np) - call mpi_bcast(dat,1,MPI_LOGICAL,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,MPI_LOGICAL,root_,icomm,info) #endif end subroutine psb_lbcasts @@ -188,18 +152,19 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(inout) :: dat logical, intent(inout), optional :: rec - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) + icomm = psb_get_mpi_comm(ictxt) if (present(rec)) then - call mpi_allreduce(dat,rec,1,MPI_LOGICAL,MPI_LAND,ictxt,info) + call mpi_allreduce(dat,rec,1,MPI_LOGICAL,MPI_LAND,icomm,info) else - call mpi_allreduce(MPI_IN_PLACE,dat,1,MPI_LOGICAL,MPI_LAND,ictxt,info) + call mpi_allreduce(MPI_IN_PLACE,dat,1,MPI_LOGICAL,MPI_LAND,icomm,info) endif #endif @@ -214,11 +179,11 @@ end subroutine psb_lallreduceand #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root - integer(psb_mpk_) :: iam, np, root_,info + integer(psb_mpk_) :: iam, np, root_,info, icomm #if !defined(SERIAL_MPI) if (present(root)) then @@ -226,48 +191,13 @@ end subroutine psb_lallreduceand else root_ = psb_root_ endif - call psb_info(ictxt,iam,np) - call mpi_bcast(dat,size(dat),MPI_LOGICAL,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),MPI_LOGICAL,root_,icomm,info) #endif end subroutine psb_lbcastv - - subroutine psb_lbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - logical, intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_lbcasts_ec - - subroutine psb_lbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - logical, intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_lbcastv_ec - - - #if defined(SHORT_INTEGERS) subroutine psb_i2sums(ictxt,dat,root) @@ -283,7 +213,7 @@ end subroutine psb_lallreduceand integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -295,11 +225,12 @@ end subroutine psb_lallreduceand else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif @@ -320,7 +251,7 @@ end subroutine psb_lallreduceand integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -332,18 +263,19 @@ end subroutine psb_lallreduceand else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_i2pk_,mpi_sum,ictxt,info) + & psb_mpi_i2pk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -363,7 +295,7 @@ end subroutine psb_lallreduceand integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -375,71 +307,24 @@ end subroutine psb_lallreduceand else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat if (iinfo == psb_success_) call mpi_allreduce(dat_,dat,size(dat),& - & psb_mpi_i2pk_,mpi_sum,ictxt,info) + & psb_mpi_i2pk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_i2summ - subroutine psb_i2sums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_i2sums_ec - - subroutine psb_i2sumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_i2sumv_ec - - subroutine psb_i2summ_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_i2summ_ec - #endif end module psi_collective_mod diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index eb848a9f..05ca9a24 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -31,42 +31,33 @@ ! module psi_d_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_max - module procedure psb_dmaxs, psb_dmaxv, psb_dmaxm, & - & psb_dmaxs_ec, psb_dmaxv_ec, psb_dmaxm_ec + module procedure psb_dmaxs, psb_dmaxv, psb_dmaxm end interface interface psb_min - module procedure psb_dmins, psb_dminv, psb_dminm, & - & psb_dmins_ec, psb_dminv_ec, psb_dminm_ec + module procedure psb_dmins, psb_dminv, psb_dminm end interface psb_min interface psb_nrm2 - module procedure psb_d_nrm2s, psb_d_nrm2v, & - & psb_d_nrm2s_ec, psb_d_nrm2v_ec + module procedure psb_d_nrm2s, psb_d_nrm2v end interface psb_nrm2 interface psb_sum - module procedure psb_dsums, psb_dsumv, psb_dsumm, & - & psb_dsums_ec, psb_dsumv_ec, psb_dsumm_ec + module procedure psb_dsums, psb_dsumv, psb_dsumm end interface interface psb_amx - module procedure psb_damxs, psb_damxv, psb_damxm, & - & psb_damxs_ec, psb_damxv_ec, psb_damxm_ec + module procedure psb_damxs, psb_damxv, psb_damxm end interface interface psb_amn - module procedure psb_damns, psb_damnv, psb_damnm, & - & psb_damns_ec, psb_damnv_ec, psb_damnm_ec + module procedure psb_damns, psb_damnv, psb_damnm end interface - interface psb_bcast - module procedure psb_dbcasts, psb_dbcastv, psb_dbcastm, & - & psb_dbcasts_ec, psb_dbcastv_ec, psb_dbcastm_ec + module procedure psb_dbcasts, psb_dbcastv, psb_dbcastm end interface psb_bcast interface psb_scan_sum @@ -85,7 +76,6 @@ module psi_d_collective_mod module procedure psb_d_e_simple_triad_a2av, psb_d_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -109,12 +99,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -126,11 +116,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -145,12 +136,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -162,19 +153,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,icomm,info) end if endif #endif @@ -189,12 +181,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -206,74 +198,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_max,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_max,root_,icomm,info) end if endif #endif end subroutine psb_dmaxm - - subroutine psb_dmaxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_dmaxs_ec - - subroutine psb_dmaxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_dmaxv_ec - - subroutine psb_dmaxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_dmaxm_ec - - ! ! MIN: Minimum Value ! @@ -287,12 +230,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -304,11 +247,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -323,12 +267,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -340,19 +284,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,icomm,info) end if endif #endif @@ -367,12 +312,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -384,75 +329,26 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_min,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_min,root_,icomm,info) end if endif #endif end subroutine psb_dminm - subroutine psb_dmins_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_dmins_ec - - subroutine psb_dminv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_dminv_ec - - subroutine psb_dminm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_dminm_ec - - - ! !!!!!!!!!!!! ! ! Norm 2, only for reals @@ -466,12 +362,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -483,11 +379,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -502,12 +399,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -519,59 +416,28 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_dnrm2_op,ictxt,info) + & mpi_dnrm2_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,& - & mpi_dnrm2_op,root_,ictxt,info) + & mpi_dnrm2_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,& - & mpi_dnrm2_op,root_,ictxt,info) + & mpi_dnrm2_op,root_,icomm,info) end if endif #endif end subroutine psb_d_nrm2v - subroutine psb_d_nrm2s_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_d_nrm2s_ec - - subroutine psb_d_nrm2v_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_d_nrm2v_ec - ! ! SUM @@ -585,15 +451,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -602,11 +467,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -621,15 +487,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -638,19 +503,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -665,12 +531,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -682,73 +548,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_dsumm - subroutine psb_dsums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_dsums_ec - - subroutine psb_dsumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_dsumv_ec - - subroutine psb_dsumm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_dsumm_ec - - ! ! AMX: Maximum Absolute Value ! @@ -761,15 +579,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -778,11 +595,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -797,15 +615,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -814,19 +631,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info) end if endif #endif @@ -841,12 +659,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -858,74 +676,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damx_op,root_,icomm,info) end if endif #endif end subroutine psb_damxm - - subroutine psb_damxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_damxs_ec - - subroutine psb_damxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_damxv_ec - - subroutine psb_damxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_damxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -938,15 +707,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -955,11 +723,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -974,15 +743,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -991,19 +759,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info) end if endif #endif @@ -1018,12 +787,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1035,74 +804,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_damn_op,root_,icomm,info) end if endif #endif end subroutine psb_damnm - - subroutine psb_damns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_damns_ec - - subroutine psb_damnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_damnv_ec - - subroutine psb_damnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_damnm_ec - - ! ! BCAST Broadcast ! @@ -1115,15 +835,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1132,7 +851,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_r_dpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_r_dpk_,root_,icomm,info) #endif end subroutine psb_dbcasts @@ -1146,14 +866,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1162,8 +881,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,icomm,info) #endif end subroutine psb_dbcastv @@ -1176,12 +895,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1193,61 +912,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,icomm,info) #endif end subroutine psb_dbcastm - - subroutine psb_dbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_dbcasts_ec - - subroutine psb_dbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_dbcastv_ec - - subroutine psb_dbcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_dbcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -1262,13 +931,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -1286,7 +954,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -1312,7 +980,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1339,7 +1007,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1366,9 +1034,8 @@ contains real(psb_dpk_), intent(in) :: valsnd(:) real(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -1410,7 +1077,7 @@ contains real(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1493,7 +1160,7 @@ contains real(psb_dpk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_d_p2p_mod.F90 b/base/modules/penv/psi_d_p2p_mod.F90 index f59234f3..54b4e764 100644 --- a/base/modules/penv/psi_d_p2p_mod.F90 +++ b/base/modules/penv/psi_d_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_d_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_dsnds, psb_dsndv, psb_dsndm, & - & psb_dsnds_ec, psb_dsndv_ec, psb_dsndm_ec + module procedure psb_dsnds, psb_dsndv, psb_dsndm end interface interface psb_rcv - module procedure psb_drcvs, psb_drcvv, psb_drcvm, & - & psb_drcvs_ec, psb_drcvv_ec, psb_drcvm_ec + module procedure psb_drcvs, psb_drcvv, psb_drcvm end interface contains subroutine psb_dsnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst real(psb_dpk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_dsnds subroutine psb_dsndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_dsndv subroutine psb_dsndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m real(psb_dpk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_dsndm subroutine psb_drcvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_drcvs subroutine psb_drcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_drcvv subroutine psb_drcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_dpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m real(psb_dpk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_r_dpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_double_tag,ictxt,status,info) + & psb_double_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_drcvm - - subroutine psb_dsnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_dsnds_ec - - subroutine psb_dsndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_dsndv_ec - - subroutine psb_dsndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_dsndm_ec - - subroutine psb_drcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_drcvs_ec - - subroutine psb_drcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_drcvv_ec - - subroutine psb_drcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_dpk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_drcvm_ec - - end module psi_d_p2p_mod diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 443f5f99..c07b6e79 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -31,38 +31,30 @@ ! module psi_e_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_max - module procedure psb_emaxs, psb_emaxv, psb_emaxm, & - & psb_emaxs_ec, psb_emaxv_ec, psb_emaxm_ec + module procedure psb_emaxs, psb_emaxv, psb_emaxm end interface interface psb_min - module procedure psb_emins, psb_eminv, psb_eminm, & - & psb_emins_ec, psb_eminv_ec, psb_eminm_ec + module procedure psb_emins, psb_eminv, psb_eminm end interface psb_min interface psb_sum - module procedure psb_esums, psb_esumv, psb_esumm, & - & psb_esums_ec, psb_esumv_ec, psb_esumm_ec + module procedure psb_esums, psb_esumv, psb_esumm end interface interface psb_amx - module procedure psb_eamxs, psb_eamxv, psb_eamxm, & - & psb_eamxs_ec, psb_eamxv_ec, psb_eamxm_ec + module procedure psb_eamxs, psb_eamxv, psb_eamxm end interface interface psb_amn - module procedure psb_eamns, psb_eamnv, psb_eamnm, & - & psb_eamns_ec, psb_eamnv_ec, psb_eamnm_ec + module procedure psb_eamns, psb_eamnv, psb_eamnm end interface - interface psb_bcast - module procedure psb_ebcasts, psb_ebcastv, psb_ebcastm, & - & psb_ebcasts_ec, psb_ebcastv_ec, psb_ebcastm_ec + module procedure psb_ebcasts, psb_ebcastv, psb_ebcastm end interface psb_bcast interface psb_scan_sum @@ -81,7 +73,6 @@ module psi_e_collective_mod module procedure psb_e_e_simple_triad_a2av, psb_e_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -105,12 +96,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -122,11 +113,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_max,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -141,12 +133,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -158,19 +150,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_max,root_,icomm,info) end if endif #endif @@ -185,12 +178,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -202,74 +195,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_max,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_max,root_,icomm,info) end if endif #endif end subroutine psb_emaxm - - subroutine psb_emaxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_emaxs_ec - - subroutine psb_emaxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_emaxv_ec - - subroutine psb_emaxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_emaxm_ec - - ! ! MIN: Minimum Value ! @@ -283,12 +227,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -300,11 +244,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_min,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -319,12 +264,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -336,19 +281,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_min,root_,icomm,info) end if endif #endif @@ -363,12 +309,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -380,75 +326,26 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_min,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_min,root_,icomm,info) end if endif #endif end subroutine psb_eminm - subroutine psb_emins_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_emins_ec - - subroutine psb_eminv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_eminv_ec - - subroutine psb_eminm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_eminm_ec - - - ! ! SUM @@ -462,15 +359,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -479,11 +375,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -498,15 +395,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -515,19 +411,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -542,12 +439,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -559,73 +456,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_esumm - subroutine psb_esums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_esums_ec - - subroutine psb_esumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_esumv_ec - - subroutine psb_esumm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_esumm_ec - - ! ! AMX: Maximum Absolute Value ! @@ -638,15 +487,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -655,11 +503,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -674,15 +523,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -691,19 +539,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,icomm,info) end if endif #endif @@ -718,12 +567,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -735,74 +584,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamx_op,root_,icomm,info) end if endif #endif end subroutine psb_eamxm - - subroutine psb_eamxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_eamxs_ec - - subroutine psb_eamxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_eamxv_ec - - subroutine psb_eamxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_eamxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -815,15 +615,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -832,11 +631,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -851,15 +651,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -868,19 +667,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,icomm,info) end if endif #endif @@ -895,12 +695,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -912,74 +712,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_epk_,mpi_eamn_op,root_,icomm,info) end if endif #endif end subroutine psb_eamnm - - subroutine psb_eamns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_eamns_ec - - subroutine psb_eamnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_eamnv_ec - - subroutine psb_eamnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_eamnm_ec - - ! ! BCAST Broadcast ! @@ -992,15 +743,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1009,7 +759,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_epk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_epk_,root_,icomm,info) #endif end subroutine psb_ebcasts @@ -1023,14 +774,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1039,8 +789,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_epk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_epk_,root_,icomm,info) #endif end subroutine psb_ebcastv @@ -1053,12 +803,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1070,61 +820,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_epk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_epk_,root_,icomm,info) #endif end subroutine psb_ebcastm - - subroutine psb_ebcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_ebcasts_ec - - subroutine psb_ebcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_ebcastv_ec - - subroutine psb_ebcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_ebcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -1139,13 +839,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -1163,7 +862,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -1189,7 +888,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1216,7 +915,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1243,9 +942,8 @@ contains integer(psb_epk_), intent(in) :: valsnd(:) integer(psb_epk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -1287,7 +985,7 @@ contains integer(psb_epk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1370,7 +1068,7 @@ contains integer(psb_epk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_e_p2p_mod.F90 b/base/modules/penv/psi_e_p2p_mod.F90 index d72f4ee0..239eb283 100644 --- a/base/modules/penv/psi_e_p2p_mod.F90 +++ b/base/modules/penv/psi_e_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_e_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_esnds, psb_esndv, psb_esndm, & - & psb_esnds_ec, psb_esndv_ec, psb_esndm_ec + module procedure psb_esnds, psb_esndv, psb_esndm end interface interface psb_rcv - module procedure psb_ercvs, psb_ercvv, psb_ercvm, & - & psb_ercvs_ec, psb_ercvv_ec, psb_ercvm_ec + module procedure psb_ercvs, psb_ercvv, psb_ercvm end interface contains subroutine psb_esnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst integer(psb_epk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_esnds subroutine psb_esndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_esndv subroutine psb_esndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m integer(psb_epk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_esndm subroutine psb_ercvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_epk_,src,psb_int8_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_ercvs subroutine psb_ercvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_ercvv subroutine psb_ercvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_epk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m integer(psb_epk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_epk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int8_tag,ictxt,status,info) + & psb_int8_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_ercvm - - subroutine psb_esnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_esnds_ec - - subroutine psb_esndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_esndv_ec - - subroutine psb_esndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_esndm_ec - - subroutine psb_ercvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_ercvs_ec - - subroutine psb_ercvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_ercvv_ec - - subroutine psb_ercvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_epk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_ercvm_ec - - end module psi_e_p2p_mod diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 31a245b6..5a70af58 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -31,38 +31,30 @@ ! module psi_i2_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_max - module procedure psb_i2maxs, psb_i2maxv, psb_i2maxm, & - & psb_i2maxs_ec, psb_i2maxv_ec, psb_i2maxm_ec + module procedure psb_i2maxs, psb_i2maxv, psb_i2maxm end interface interface psb_min - module procedure psb_i2mins, psb_i2minv, psb_i2minm, & - & psb_i2mins_ec, psb_i2minv_ec, psb_i2minm_ec + module procedure psb_i2mins, psb_i2minv, psb_i2minm end interface psb_min interface psb_sum - module procedure psb_i2sums, psb_i2sumv, psb_i2summ, & - & psb_i2sums_ec, psb_i2sumv_ec, psb_i2summ_ec + module procedure psb_i2sums, psb_i2sumv, psb_i2summ end interface interface psb_amx - module procedure psb_i2amxs, psb_i2amxv, psb_i2amxm, & - & psb_i2amxs_ec, psb_i2amxv_ec, psb_i2amxm_ec + module procedure psb_i2amxs, psb_i2amxv, psb_i2amxm end interface interface psb_amn - module procedure psb_i2amns, psb_i2amnv, psb_i2amnm, & - & psb_i2amns_ec, psb_i2amnv_ec, psb_i2amnm_ec + module procedure psb_i2amns, psb_i2amnv, psb_i2amnm end interface - interface psb_bcast - module procedure psb_i2bcasts, psb_i2bcastv, psb_i2bcastm, & - & psb_i2bcasts_ec, psb_i2bcastv_ec, psb_i2bcastm_ec + module procedure psb_i2bcasts, psb_i2bcastv, psb_i2bcastm end interface psb_bcast interface psb_scan_sum @@ -81,7 +73,6 @@ module psi_i2_collective_mod module procedure psb_i2_e_simple_triad_a2av, psb_i2_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -105,12 +96,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -122,11 +113,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -141,12 +133,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -158,19 +150,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_max,root_,icomm,info) end if endif #endif @@ -185,12 +178,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -202,74 +195,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_max,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_max,root_,icomm,info) end if endif #endif end subroutine psb_i2maxm - - subroutine psb_i2maxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_i2maxs_ec - - subroutine psb_i2maxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_i2maxv_ec - - subroutine psb_i2maxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_i2maxm_ec - - ! ! MIN: Minimum Value ! @@ -283,12 +227,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -300,11 +244,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -319,12 +264,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -336,19 +281,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_min,root_,icomm,info) end if endif #endif @@ -363,12 +309,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -380,75 +326,26 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_min,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_min,root_,icomm,info) end if endif #endif end subroutine psb_i2minm - subroutine psb_i2mins_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_i2mins_ec - - subroutine psb_i2minv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_i2minv_ec - - subroutine psb_i2minm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_i2minm_ec - - - ! ! SUM @@ -462,15 +359,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -479,11 +375,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -498,15 +395,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -515,19 +411,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -542,12 +439,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -559,73 +456,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_i2summ - subroutine psb_i2sums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_i2sums_ec - - subroutine psb_i2sumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_i2sumv_ec - - subroutine psb_i2summ_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_i2summ_ec - - ! ! AMX: Maximum Absolute Value ! @@ -638,15 +487,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -655,11 +503,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -674,15 +523,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -691,19 +539,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info) end if endif #endif @@ -718,12 +567,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -735,74 +584,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amx_op,root_,icomm,info) end if endif #endif end subroutine psb_i2amxm - - subroutine psb_i2amxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_i2amxs_ec - - subroutine psb_i2amxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_i2amxv_ec - - subroutine psb_i2amxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_i2amxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -815,15 +615,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -832,11 +631,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -851,15 +651,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -868,19 +667,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info) end if endif #endif @@ -895,12 +695,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_i2pk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -912,74 +712,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_i2pk_,mpi_i2amn_op,root_,icomm,info) end if endif #endif end subroutine psb_i2amnm - - subroutine psb_i2amns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_i2amns_ec - - subroutine psb_i2amnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_i2amnv_ec - - subroutine psb_i2amnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_i2amnm_ec - - ! ! BCAST Broadcast ! @@ -992,15 +743,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1009,7 +759,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_i2pk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_i2pk_,root_,icomm,info) #endif end subroutine psb_i2bcasts @@ -1023,14 +774,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1039,8 +789,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,icomm,info) #endif end subroutine psb_i2bcastv @@ -1053,12 +803,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1070,61 +820,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,icomm,info) #endif end subroutine psb_i2bcastm - - subroutine psb_i2bcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_i2bcasts_ec - - subroutine psb_i2bcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_i2bcastv_ec - - subroutine psb_i2bcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_i2bcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -1139,13 +839,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_i2pk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -1163,7 +862,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_i2pk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -1189,7 +888,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1216,7 +915,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1243,9 +942,8 @@ contains integer(psb_i2pk_), intent(in) :: valsnd(:) integer(psb_i2pk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -1287,7 +985,7 @@ contains integer(psb_i2pk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1370,7 +1068,7 @@ contains integer(psb_i2pk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_i2_p2p_mod.F90 b/base/modules/penv/psi_i2_p2p_mod.F90 index 84bf7712..f24dc464 100644 --- a/base/modules/penv/psi_i2_p2p_mod.F90 +++ b/base/modules/penv/psi_i2_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_i2_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_i2snds, psb_i2sndv, psb_i2sndm, & - & psb_i2snds_ec, psb_i2sndv_ec, psb_i2sndm_ec + module procedure psb_i2snds, psb_i2sndv, psb_i2sndm end interface interface psb_rcv - module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm, & - & psb_i2rcvs_ec, psb_i2rcvv_ec, psb_i2rcvm_ec + module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm end interface contains subroutine psb_i2snds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst integer(psb_i2pk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_i2snds subroutine psb_i2sndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_i2sndv subroutine psb_i2sndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_i2sndm subroutine psb_i2rcvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_i2rcvs subroutine psb_i2rcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_i2pk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_i2rcvv subroutine psb_i2rcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_i2pk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m integer(psb_i2pk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_i2pk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int2_tag,ictxt,status,info) + & psb_int2_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_i2rcvm - - subroutine psb_i2snds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_i2snds_ec - - subroutine psb_i2sndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_i2sndv_ec - - subroutine psb_i2sndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_i2sndm_ec - - subroutine psb_i2rcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_i2rcvs_ec - - subroutine psb_i2rcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_i2rcvv_ec - - subroutine psb_i2rcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_i2pk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_i2rcvm_ec - - end module psi_i2_p2p_mod diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index 8badcf87..867f997e 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -31,38 +31,30 @@ ! module psi_m_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_max - module procedure psb_mmaxs, psb_mmaxv, psb_mmaxm, & - & psb_mmaxs_ec, psb_mmaxv_ec, psb_mmaxm_ec + module procedure psb_mmaxs, psb_mmaxv, psb_mmaxm end interface interface psb_min - module procedure psb_mmins, psb_mminv, psb_mminm, & - & psb_mmins_ec, psb_mminv_ec, psb_mminm_ec + module procedure psb_mmins, psb_mminv, psb_mminm end interface psb_min interface psb_sum - module procedure psb_msums, psb_msumv, psb_msumm, & - & psb_msums_ec, psb_msumv_ec, psb_msumm_ec + module procedure psb_msums, psb_msumv, psb_msumm end interface interface psb_amx - module procedure psb_mamxs, psb_mamxv, psb_mamxm, & - & psb_mamxs_ec, psb_mamxv_ec, psb_mamxm_ec + module procedure psb_mamxs, psb_mamxv, psb_mamxm end interface interface psb_amn - module procedure psb_mamns, psb_mamnv, psb_mamnm, & - & psb_mamns_ec, psb_mamnv_ec, psb_mamnm_ec + module procedure psb_mamns, psb_mamnv, psb_mamnm end interface - interface psb_bcast - module procedure psb_mbcasts, psb_mbcastv, psb_mbcastm, & - & psb_mbcasts_ec, psb_mbcastv_ec, psb_mbcastm_ec + module procedure psb_mbcasts, psb_mbcastv, psb_mbcastm end interface psb_bcast interface psb_scan_sum @@ -81,7 +73,6 @@ module psi_m_collective_mod module procedure psb_m_e_simple_triad_a2av, psb_m_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -105,12 +96,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -122,11 +113,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -141,12 +133,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -158,19 +150,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,icomm,info) end if endif #endif @@ -185,12 +178,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -202,74 +195,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_max,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_max,root_,icomm,info) end if endif #endif end subroutine psb_mmaxm - - subroutine psb_mmaxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_mmaxs_ec - - subroutine psb_mmaxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_mmaxv_ec - - subroutine psb_mmaxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_mmaxm_ec - - ! ! MIN: Minimum Value ! @@ -283,12 +227,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -300,11 +244,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -319,12 +264,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -336,19 +281,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,icomm,info) end if endif #endif @@ -363,12 +309,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -380,75 +326,26 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_min,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_min,root_,icomm,info) end if endif #endif end subroutine psb_mminm - subroutine psb_mmins_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_mmins_ec - - subroutine psb_mminv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_mminv_ec - - subroutine psb_mminm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_mminm_ec - - - ! ! SUM @@ -462,15 +359,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -479,11 +375,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -498,15 +395,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -515,19 +411,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -542,12 +439,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -559,73 +456,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_msumm - subroutine psb_msums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_msums_ec - - subroutine psb_msumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_msumv_ec - - subroutine psb_msumm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_msumm_ec - - ! ! AMX: Maximum Absolute Value ! @@ -638,15 +487,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -655,11 +503,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -674,15 +523,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -691,19 +539,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info) end if endif #endif @@ -718,12 +567,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -735,74 +584,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamx_op,root_,icomm,info) end if endif #endif end subroutine psb_mamxm - - subroutine psb_mamxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_mamxs_ec - - subroutine psb_mamxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_mamxv_ec - - subroutine psb_mamxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_mamxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -815,15 +615,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -832,11 +631,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -851,15 +651,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -868,19 +667,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info) end if endif #endif @@ -895,12 +695,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -912,74 +712,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_mpk_,mpi_mamn_op,root_,icomm,info) end if endif #endif end subroutine psb_mamnm - - subroutine psb_mamns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_mamns_ec - - subroutine psb_mamnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_mamnv_ec - - subroutine psb_mamnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_mamnm_ec - - ! ! BCAST Broadcast ! @@ -992,15 +743,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1009,7 +759,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_mpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_mpk_,root_,icomm,info) #endif end subroutine psb_mbcasts @@ -1023,14 +774,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1039,8 +789,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_mpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_mpk_,root_,icomm,info) #endif end subroutine psb_mbcastv @@ -1053,12 +803,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1070,61 +820,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_mpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_mpk_,root_,icomm,info) #endif end subroutine psb_mbcastm - - subroutine psb_mbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_mbcasts_ec - - subroutine psb_mbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_mbcastv_ec - - subroutine psb_mbcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_mbcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -1139,13 +839,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -1163,7 +862,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -1189,7 +888,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1216,7 +915,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1243,9 +942,8 @@ contains integer(psb_mpk_), intent(in) :: valsnd(:) integer(psb_mpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -1287,7 +985,7 @@ contains integer(psb_mpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1370,7 +1068,7 @@ contains integer(psb_mpk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_m_p2p_mod.F90 b/base/modules/penv/psi_m_p2p_mod.F90 index f2600dc6..8f6801b4 100644 --- a/base/modules/penv/psi_m_p2p_mod.F90 +++ b/base/modules/penv/psi_m_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_m_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_msnds, psb_msndv, psb_msndm, & - & psb_msnds_ec, psb_msndv_ec, psb_msndm_ec + module procedure psb_msnds, psb_msndv, psb_msndm end interface interface psb_rcv - module procedure psb_mrcvs, psb_mrcvv, psb_mrcvm, & - & psb_mrcvs_ec, psb_mrcvv_ec, psb_mrcvm_ec + module procedure psb_mrcvs, psb_mrcvv, psb_mrcvm end interface contains subroutine psb_msnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_msnds subroutine psb_msndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_msndv subroutine psb_msndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m integer(psb_mpk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_msndm subroutine psb_mrcvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_mrcvs subroutine psb_mrcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_mrcvv subroutine psb_mrcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m integer(psb_mpk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_int4_tag,ictxt,status,info) + & psb_int4_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_mrcvm - - subroutine psb_msnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_msnds_ec - - subroutine psb_msndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_msndv_ec - - subroutine psb_msndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_msndm_ec - - subroutine psb_mrcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_mrcvs_ec - - subroutine psb_mrcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_mrcvv_ec - - subroutine psb_mrcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - integer(psb_mpk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_mrcvm_ec - - end module psi_m_p2p_mod diff --git a/base/modules/penv/psi_p2p_mod.F90 b/base/modules/penv/psi_p2p_mod.F90 index 39234474..0b00cbb6 100644 --- a/base/modules/penv/psi_p2p_mod.F90 +++ b/base/modules/penv/psi_p2p_mod.F90 @@ -32,7 +32,6 @@ module psi_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod use psi_m_p2p_mod use psi_e_p2p_mod @@ -49,13 +48,11 @@ module psi_p2p_mod ! interface psb_snd module procedure psb_lsnds, psb_lsndv, psb_lsndm,& - & psb_hsnds, psb_lsnds_ec, psb_lsndv_ec, & - & psb_lsndm_ec, psb_hsnds_ec + & psb_hsnds end interface interface psb_rcv module procedure psb_lrcvs, psb_lrcvv, psb_lrcvm,& - & psb_hrcvs, psb_lrcvs_ec, psb_lrcvv_ec, & - & psb_lrcvm_ec, psb_hrcvs_ec + & psb_hrcvs end interface @@ -69,7 +66,6 @@ contains ! !!!!!!!!!!!!!!!!!!!!!!!! subroutine psb_lsnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -77,7 +73,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(in) :: dat integer(psb_mpk_), intent(in) :: dst logical, allocatable :: dat_(:) @@ -92,7 +88,6 @@ contains end subroutine psb_lsnds subroutine psb_lsndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -101,7 +96,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst logical, allocatable :: dat_(:) @@ -117,7 +112,6 @@ contains end subroutine psb_lsndv subroutine psb_lsndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -126,7 +120,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -155,7 +149,7 @@ contains end subroutine psb_lsndm subroutine psb_hsnds(ictxt,dat,dst) - use psi_comm_buffers_mod + #ifdef MPI_MOD use mpi #endif @@ -163,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt character(len=*), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst character(len=1), allocatable :: dat_(:) @@ -180,63 +174,6 @@ contains #endif end subroutine psb_hsnds - subroutine psb_lsnds_ec(ictxt,dat,dst) - integer(psb_epk_), intent(in) :: ictxt - logical, intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_lsnds_ec - - subroutine psb_lsndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - logical, intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_lsndv_ec - - subroutine psb_lsndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - logical, intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_lsndm_ec - - - subroutine psb_hsnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - character(len=*), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_hsnds_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!! ! ! Point-to-point RCV @@ -244,7 +181,7 @@ contains ! !!!!!!!!!!!!!!!!!!!!!!!! subroutine psb_lrcvs(ictxt,dat,src) - use psi_comm_buffers_mod + #ifdef MPI_MOD use mpi #endif @@ -252,21 +189,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_lrcvs subroutine psb_lrcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -275,7 +212,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info @@ -289,7 +226,6 @@ contains end subroutine psb_lrcvv subroutine psb_lrcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -298,16 +234,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_ipk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else + icomm = psb_get_mpi_comm(ictxt) if (present(m)) then m_ = m ld = size(dat,1) @@ -315,11 +252,11 @@ contains call mpi_type_vector(n_,m_,ld,mpi_logical,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_logical_tag,ictxt,status,info) + & psb_logical_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else call mpi_recv(dat,size(dat),mpi_logical,src,& - & psb_logical_tag,ictxt,status,info) + & psb_logical_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -330,7 +267,7 @@ contains subroutine psb_hrcvs(ictxt,dat,src) - use psi_comm_buffers_mod + #ifdef MPI_MOD use mpi #endif @@ -338,18 +275,19 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt character(len=*), intent(out) :: dat integer(psb_mpk_), intent(in) :: src character(len=1), allocatable :: dat_(:) integer(psb_mpk_) :: info, l, i - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! do nothing #else l = len(dat) + icomm = psb_get_mpi_comm(ictxt) allocate(dat_(l), stat=info) - call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,ictxt,status,info) + call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) do i=1, l dat(i:i) = dat_(i) @@ -358,61 +296,4 @@ contains #endif end subroutine psb_hrcvs - - subroutine psb_lrcvs_ec(ictxt,dat,src) - integer(psb_epk_), intent(in) :: ictxt - logical, intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_lrcvs_ec - - subroutine psb_lrcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - logical, intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_lrcvv_ec - - subroutine psb_lrcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - logical, intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_lrcvm_ec - - - subroutine psb_hrcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - character(len=*), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_hrcvs_ec - end module psi_p2p_mod diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index 65a0a3ac..4ddef9e0 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -144,7 +144,12 @@ module psi_penv_mod interface psb_info module procedure psb_info_mpik end interface - +#if defined(IPK4) && defined(LPK8) + interface psb_info + module procedure psb_info_epk + end interface +#endif + interface psb_barrier module procedure psb_barrier_mpik end interface @@ -392,7 +397,7 @@ contains return end if call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,& - & dest,tag,icontxt,node%request,minfo) + & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -852,23 +857,22 @@ contains !!$ end if !!$ end subroutine psb_abort_epk !!$ -!!$ subroutine psb_info_epk(ictxt,iam,np) -!!$ -!!$ integer(psb_epk_), intent(in) :: ictxt -!!$ integer(psb_epk_), intent(out) :: iam, np -!!$ -!!$ ! -!!$ ! Simple caching scheme, keep track -!!$ ! of the last CTXT encountered. -!!$ ! -!!$ integer(psb_mpk_), save :: lctxt=-1, lam, lnp -!!$ if (ictxt /= lctxt) then -!!$ lctxt = ictxt -!!$ call psb_info(lctxt,lam,lnp) -!!$ end if -!!$ iam = lam -!!$ np = lnp -!!$ end subroutine psb_info_epk +#if defined(IPK4) && defined(LPK8) + subroutine psb_info_epk(ictxt,iam,np) + + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_epk_), intent(out) :: iam, np + + ! + ! Simple caching scheme, keep track + ! of the last CTXT encountered. + ! + integer(psb_mpk_), save :: lam, lnp + call psb_info(ictxt,lam,lnp) + iam = lam + np = lnp + end subroutine psb_info_epk +#endif subroutine psb_init_mpik(ictxt,np,basectxt,ids) use psb_const_mod diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index e4fb9d06..a9a249ee 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -31,42 +31,33 @@ ! module psi_s_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_max - module procedure psb_smaxs, psb_smaxv, psb_smaxm, & - & psb_smaxs_ec, psb_smaxv_ec, psb_smaxm_ec + module procedure psb_smaxs, psb_smaxv, psb_smaxm end interface interface psb_min - module procedure psb_smins, psb_sminv, psb_sminm, & - & psb_smins_ec, psb_sminv_ec, psb_sminm_ec + module procedure psb_smins, psb_sminv, psb_sminm end interface psb_min interface psb_nrm2 - module procedure psb_s_nrm2s, psb_s_nrm2v, & - & psb_s_nrm2s_ec, psb_s_nrm2v_ec + module procedure psb_s_nrm2s, psb_s_nrm2v end interface psb_nrm2 interface psb_sum - module procedure psb_ssums, psb_ssumv, psb_ssumm, & - & psb_ssums_ec, psb_ssumv_ec, psb_ssumm_ec + module procedure psb_ssums, psb_ssumv, psb_ssumm end interface interface psb_amx - module procedure psb_samxs, psb_samxv, psb_samxm, & - & psb_samxs_ec, psb_samxv_ec, psb_samxm_ec + module procedure psb_samxs, psb_samxv, psb_samxm end interface interface psb_amn - module procedure psb_samns, psb_samnv, psb_samnm, & - & psb_samns_ec, psb_samnv_ec, psb_samnm_ec + module procedure psb_samns, psb_samnv, psb_samnm end interface - interface psb_bcast - module procedure psb_sbcasts, psb_sbcastv, psb_sbcastm, & - & psb_sbcasts_ec, psb_sbcastv_ec, psb_sbcastm_ec + module procedure psb_sbcasts, psb_sbcastv, psb_sbcastm end interface psb_bcast interface psb_scan_sum @@ -85,7 +76,6 @@ module psi_s_collective_mod module procedure psb_s_e_simple_triad_a2av, psb_s_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -109,12 +99,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -126,11 +116,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -145,12 +136,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -162,19 +153,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,icomm,info) end if endif #endif @@ -189,12 +181,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -206,74 +198,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_max,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_max,root_,icomm,info) end if endif #endif end subroutine psb_smaxm - - subroutine psb_smaxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_smaxs_ec - - subroutine psb_smaxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_smaxv_ec - - subroutine psb_smaxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_max(ictxt_,dat,root_) - else - call psb_max(ictxt_,dat) - end if - end subroutine psb_smaxm_ec - - ! ! MIN: Minimum Value ! @@ -287,12 +230,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -304,11 +247,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -323,12 +267,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -340,19 +284,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,icomm,info) end if endif #endif @@ -367,12 +312,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -384,75 +329,26 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_min,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_min,root_,icomm,info) end if endif #endif end subroutine psb_sminm - subroutine psb_smins_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_smins_ec - - subroutine psb_sminv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_sminv_ec - - subroutine psb_sminm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_min(ictxt_,dat,root_) - else - call psb_min(ictxt_,dat) - end if - end subroutine psb_sminm_ec - - - ! !!!!!!!!!!!! ! ! Norm 2, only for reals @@ -466,12 +362,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -483,11 +379,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -502,12 +399,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo @@ -519,59 +416,28 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,& - & mpi_snrm2_op,ictxt,info) + & mpi_snrm2_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,& - & mpi_snrm2_op,root_,ictxt,info) + & mpi_snrm2_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,& - & mpi_snrm2_op,root_,ictxt,info) + & mpi_snrm2_op,root_,icomm,info) end if endif #endif end subroutine psb_s_nrm2v - subroutine psb_s_nrm2s_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_s_nrm2s_ec - - subroutine psb_s_nrm2v_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_nrm2(ictxt_,dat,root_) - else - call psb_nrm2(ictxt_,dat) - end if - end subroutine psb_s_nrm2v_ec - ! ! SUM @@ -585,15 +451,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -602,11 +467,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -621,15 +487,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -638,19 +503,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -665,12 +531,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -682,73 +548,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_ssumm - subroutine psb_ssums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_ssums_ec - - subroutine psb_ssumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_ssumv_ec - - subroutine psb_ssumm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_ssumm_ec - - ! ! AMX: Maximum Absolute Value ! @@ -761,15 +579,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -778,11 +595,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -797,15 +615,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -814,19 +631,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info) end if endif #endif @@ -841,12 +659,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -858,74 +676,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samx_op,root_,icomm,info) end if endif #endif end subroutine psb_samxm - - subroutine psb_samxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_samxs_ec - - subroutine psb_samxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_samxv_ec - - subroutine psb_samxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_samxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -938,15 +707,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -955,11 +723,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -974,15 +743,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -991,19 +759,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info) end if endif #endif @@ -1018,12 +787,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1035,74 +804,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_samn_op,root_,icomm,info) end if endif #endif end subroutine psb_samnm - - subroutine psb_samns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_samns_ec - - subroutine psb_samnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_samnv_ec - - subroutine psb_samnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_samnm_ec - - ! ! BCAST Broadcast ! @@ -1115,15 +835,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1132,7 +851,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_r_spk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_r_spk_,root_,icomm,info) #endif end subroutine psb_sbcasts @@ -1146,14 +866,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -1162,8 +881,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,icomm,info) #endif end subroutine psb_sbcastv @@ -1176,12 +895,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -1193,61 +912,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,icomm,info) #endif end subroutine psb_sbcastm - - subroutine psb_sbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_sbcasts_ec - - subroutine psb_sbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_sbcastv_ec - - subroutine psb_sbcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_sbcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -1262,13 +931,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -1286,7 +954,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -1312,7 +980,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1339,7 +1007,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1366,9 +1034,8 @@ contains real(psb_spk_), intent(in) :: valsnd(:) real(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -1410,7 +1077,7 @@ contains real(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1493,7 +1160,7 @@ contains real(psb_spk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_s_p2p_mod.F90 b/base/modules/penv/psi_s_p2p_mod.F90 index 91f4d739..12c19c6e 100644 --- a/base/modules/penv/psi_s_p2p_mod.F90 +++ b/base/modules/penv/psi_s_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_s_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_ssnds, psb_ssndv, psb_ssndm, & - & psb_ssnds_ec, psb_ssndv_ec, psb_ssndm_ec + module procedure psb_ssnds, psb_ssndv, psb_ssndm end interface interface psb_rcv - module procedure psb_srcvs, psb_srcvv, psb_srcvm, & - & psb_srcvs_ec, psb_srcvv_ec, psb_srcvm_ec + module procedure psb_srcvs, psb_srcvv, psb_srcvm end interface contains subroutine psb_ssnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst real(psb_spk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_ssnds subroutine psb_ssndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_ssndv subroutine psb_ssndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m real(psb_spk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_ssndm subroutine psb_srcvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_srcvs subroutine psb_srcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_srcvv subroutine psb_srcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt real(psb_spk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m real(psb_spk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_r_spk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_real_tag,ictxt,status,info) + & psb_real_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_srcvm - - subroutine psb_ssnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_ssnds_ec - - subroutine psb_ssndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_ssndv_ec - - subroutine psb_ssndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_ssndm_ec - - subroutine psb_srcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_srcvs_ec - - subroutine psb_srcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_srcvv_ec - - subroutine psb_srcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - real(psb_spk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_srcvm_ec - - end module psi_s_p2p_mod diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index 8a58ffb5..a1d43252 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -31,28 +31,22 @@ ! module psi_z_collective_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_sum - module procedure psb_zsums, psb_zsumv, psb_zsumm, & - & psb_zsums_ec, psb_zsumv_ec, psb_zsumm_ec + module procedure psb_zsums, psb_zsumv, psb_zsumm end interface interface psb_amx - module procedure psb_zamxs, psb_zamxv, psb_zamxm, & - & psb_zamxs_ec, psb_zamxv_ec, psb_zamxm_ec + module procedure psb_zamxs, psb_zamxv, psb_zamxm end interface interface psb_amn - module procedure psb_zamns, psb_zamnv, psb_zamnm, & - & psb_zamns_ec, psb_zamnv_ec, psb_zamnm_ec + module procedure psb_zamns, psb_zamnv, psb_zamnm end interface - interface psb_bcast - module procedure psb_zbcasts, psb_zbcastv, psb_zbcastm, & - & psb_zbcasts_ec, psb_zbcastv_ec, psb_zbcastm_ec + module procedure psb_zbcasts, psb_zbcastv, psb_zbcastm end interface psb_bcast interface psb_scan_sum @@ -71,7 +65,6 @@ module psi_z_collective_mod module procedure psb_z_e_simple_triad_a2av, psb_z_m_simple_triad_a2av end interface psb_simple_triad_a2av - contains ! !!!!!!!!!!!!!!!!!!!!!! @@ -94,15 +87,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -111,11 +103,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -130,15 +123,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -147,19 +139,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info) end if endif #endif @@ -174,12 +167,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -191,73 +184,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,root_,icomm,info) end if endif #endif end subroutine psb_zsumm - subroutine psb_zsums_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_zsums_ec - - subroutine psb_zsumv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_zsumv_ec - - subroutine psb_zsumm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_sum(ictxt_,dat,root_) - else - call psb_sum(ictxt_,dat) - end if - end subroutine psb_zsumm_ec - - ! ! AMX: Maximum Absolute Value ! @@ -270,15 +215,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -287,11 +231,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -306,15 +251,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -323,19 +267,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) end if endif #endif @@ -350,12 +295,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -367,74 +312,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamx_op,root_,icomm,info) end if endif #endif end subroutine psb_zamxm - - subroutine psb_zamxs_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_zamxs_ec - - subroutine psb_zamxv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_zamxv_ec - - subroutine psb_zamxm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amx(ictxt_,dat,root_) - else - call psb_amx(ictxt_,dat) - end if - end subroutine psb_zamxm_ec - - ! ! AMN: Minimum Absolute Value ! @@ -447,15 +343,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -464,11 +359,12 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) + call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) if (iam == root_) dat = dat_ endif #endif @@ -483,15 +379,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -500,19 +395,20 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat if (iinfo == psb_success_) & - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) else call psb_realloc(1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) end if endif #endif @@ -527,12 +423,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:,:) - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -544,74 +440,25 @@ contains else root_ = -1 endif + icomm = psb_get_mpi_comm(ictxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat if (iinfo == psb_success_)& - & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,ictxt,info) + & call mpi_allreduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) else if (iam == root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat_,dat,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) else call psb_realloc(1,1,dat_,iinfo) - call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,ictxt,info) + call mpi_reduce(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_zamn_op,root_,icomm,info) end if endif #endif end subroutine psb_zamnm - - subroutine psb_zamns_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_zamns_ec - - subroutine psb_zamnv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_zamnv_ec - - subroutine psb_zamnm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_amn(ictxt_,dat,root_) - else - call psb_amn(ictxt_,dat) - end if - end subroutine psb_zamnm_ec - - ! ! BCAST Broadcast ! @@ -624,15 +471,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -641,7 +487,8 @@ contains else root_ = psb_root_ endif - call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,icomm,info) #endif end subroutine psb_zbcasts @@ -655,14 +502,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) @@ -671,8 +517,8 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info) #endif end subroutine psb_zbcastv @@ -685,12 +531,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ - integer(psb_mpk_) :: iam, np, info + integer(psb_mpk_) :: iam, np, info, icomm integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) @@ -702,61 +548,11 @@ contains else root_ = psb_root_ endif - - call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info) #endif end subroutine psb_zbcastm - - subroutine psb_zbcasts_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_zbcasts_ec - - subroutine psb_zbcastv_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_zbcastv_ec - - subroutine psb_zbcastm_ec(ictxt,dat,root) - implicit none - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(inout) :: dat(:,:) - integer(psb_epk_), intent(in), optional :: root - integer(psb_mpk_) :: ictxt_, root_ - - ictxt_ = ictxt - if (present(root)) then - root_ = root - call psb_bcast(ictxt_,dat,root_) - else - call psb_bcast(ictxt_,dat) - end if - end subroutine psb_zbcastm_ec - - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! SCAN @@ -771,13 +567,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm - #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) icomm = psb_get_mpi_comm(ictxt) @@ -795,7 +590,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -821,7 +616,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -848,7 +643,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -875,9 +670,8 @@ contains complex(psb_dpk_), intent(in) :: valsnd(:) complex(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz call psb_info(ictxt,iam,np) @@ -919,7 +713,7 @@ contains complex(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1002,7 +796,7 @@ contains complex(psb_dpk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info !Local variables diff --git a/base/modules/penv/psi_z_p2p_mod.F90 b/base/modules/penv/psi_z_p2p_mod.F90 index b72b0ae6..7761b83d 100644 --- a/base/modules/penv/psi_z_p2p_mod.F90 +++ b/base/modules/penv/psi_z_p2p_mod.F90 @@ -32,22 +32,18 @@ module psi_z_p2p_mod use psi_penv_mod - use psi_comm_buffers_mod interface psb_snd - module procedure psb_zsnds, psb_zsndv, psb_zsndm, & - & psb_zsnds_ec, psb_zsndv_ec, psb_zsndm_ec + module procedure psb_zsnds, psb_zsndv, psb_zsndm end interface interface psb_rcv - module procedure psb_zrcvs, psb_zrcvv, psb_zrcvm, & - & psb_zrcvs_ec, psb_zrcvv_ec, psb_zrcvm_ec + module procedure psb_zrcvs, psb_zrcvv, psb_zrcvm end interface contains subroutine psb_zsnds(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -55,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst complex(psb_dpk_), allocatable :: dat_(:) @@ -70,7 +66,6 @@ contains end subroutine psb_zsnds subroutine psb_zsndv(ictxt,dat,dst) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -79,11 +74,11 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -95,7 +90,6 @@ contains end subroutine psb_zsndv subroutine psb_zsndm(ictxt,dat,dst,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -104,13 +98,13 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m complex(psb_dpk_), allocatable :: dat_(:) integer(psb_ipk_) :: i,j,k,m_,n_ - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info #if defined(SERIAL_MPI) #else @@ -133,7 +127,6 @@ contains end subroutine psb_zsndm subroutine psb_zrcvs(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi #endif @@ -141,21 +134,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) ! do nothing #else - call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_zrcvs subroutine psb_zrcvv(ictxt,dat,src) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -164,22 +157,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: info + integer(psb_mpk_) :: info, icomm integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_zrcvv subroutine psb_zrcvm(ictxt,dat,src,m) - use psi_comm_buffers_mod #ifdef MPI_MOD use mpi @@ -188,14 +181,14 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt complex(psb_dpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m complex(psb_dpk_), allocatable :: dat_(:) integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type integer(psb_mpk_) :: i,j,k - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) ! What should we do here?? #else @@ -205,11 +198,13 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_c_dpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) + icomm = psb_get_mpi_comm(ictxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& - & psb_dcomplex_tag,ictxt,status,info) + & psb_dcomplex_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,ictxt,status,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info) end if if (info /= mpi_success) then write(psb_err_unit,*) 'Error in psb_recv', info @@ -218,90 +213,4 @@ contains #endif end subroutine psb_zrcvm - - subroutine psb_zsnds_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_zsnds_ec - - subroutine psb_zsndv_ec(ictxt,dat,dst) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat(:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_zsndv_ec - - subroutine psb_zsndm_ec(ictxt,dat,dst,m) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(in) :: dat(:,:) - integer(psb_epk_), intent(in) :: dst - - integer(psb_mpk_) :: iictxt, idst - - iictxt = ictxt - idst = dst - call psb_snd(iictxt, dat, idst) - - end subroutine psb_zsndm_ec - - subroutine psb_zrcvs_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_zrcvs_ec - - subroutine psb_zrcvv_ec(ictxt,dat,src) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat(:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_zrcvv_ec - - subroutine psb_zrcvm_ec(ictxt,dat,src,m) - - integer(psb_epk_), intent(in) :: ictxt - complex(psb_dpk_), intent(out) :: dat(:,:) - integer(psb_epk_), intent(in) :: src - - integer(psb_mpk_) :: iictxt, isrc - - iictxt = ictxt - isrc = src - call psb_rcv(iictxt, dat, isrc) - - end subroutine psb_zrcvm_ec - - end module psi_z_p2p_mod diff --git a/test/fileread/runs/dfs.inp b/test/fileread/runs/dfs.inp index 22ac2034..3c6a3050 100644 --- a/test/fileread/runs/dfs.inp +++ b/test/fileread/runs/dfs.inp @@ -5,7 +5,7 @@ MM File format: MM: Matrix Market HB: Harwell-Boeing. BiCGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BJAC Preconditioner NONE DIAG BJAC CSR Storage format CSR COO JAD -BLOCK PART: Partition method BLOCK GRAPH +GRAPH PART: Partition method BLOCK GRAPH 2 ISTOPC 00500 ITMAX -1 ITRACE From b376d226cb92b3b3ee2c753c43d41d0440675e15 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 14 Nov 2020 16:42:15 +0100 Subject: [PATCH 04/12] Fixed declaration and use of CONTEXT with new type. --- base/comm/internals/psi_covrl_restr.f90 | 6 +- base/comm/internals/psi_covrl_restr_a.f90 | 6 +- base/comm/internals/psi_covrl_save.f90 | 8 +- base/comm/internals/psi_covrl_save_a.f90 | 6 +- base/comm/internals/psi_covrl_upd.f90 | 8 +- base/comm/internals/psi_covrl_upd_a.f90 | 7 +- base/comm/internals/psi_cswapdata.F90 | 30 ++-- base/comm/internals/psi_cswapdata_a.F90 | 34 ++-- base/comm/internals/psi_cswaptran.F90 | 28 +-- base/comm/internals/psi_cswaptran_a.F90 | 30 ++-- base/comm/internals/psi_dovrl_restr.f90 | 6 +- base/comm/internals/psi_dovrl_restr_a.f90 | 6 +- base/comm/internals/psi_dovrl_save.f90 | 8 +- base/comm/internals/psi_dovrl_save_a.f90 | 6 +- base/comm/internals/psi_dovrl_upd.f90 | 8 +- base/comm/internals/psi_dovrl_upd_a.f90 | 7 +- base/comm/internals/psi_dswapdata.F90 | 30 ++-- base/comm/internals/psi_dswapdata_a.F90 | 34 ++-- base/comm/internals/psi_dswaptran.F90 | 28 +-- base/comm/internals/psi_dswaptran_a.F90 | 30 ++-- base/comm/internals/psi_eovrl_restr_a.f90 | 6 +- base/comm/internals/psi_eovrl_save_a.f90 | 6 +- base/comm/internals/psi_eovrl_upd_a.f90 | 7 +- base/comm/internals/psi_eswapdata_a.F90 | 34 ++-- base/comm/internals/psi_eswaptran_a.F90 | 30 ++-- base/comm/internals/psi_i2ovrl_restr_a.f90 | 6 +- base/comm/internals/psi_i2ovrl_save_a.f90 | 6 +- base/comm/internals/psi_i2ovrl_upd_a.f90 | 7 +- base/comm/internals/psi_i2swapdata_a.F90 | 34 ++-- base/comm/internals/psi_i2swaptran_a.F90 | 30 ++-- base/comm/internals/psi_iovrl_restr.f90 | 6 +- base/comm/internals/psi_iovrl_save.f90 | 8 +- base/comm/internals/psi_iovrl_upd.f90 | 8 +- base/comm/internals/psi_iswapdata.F90 | 30 ++-- base/comm/internals/psi_iswaptran.F90 | 28 +-- base/comm/internals/psi_lovrl_restr.f90 | 6 +- base/comm/internals/psi_lovrl_save.f90 | 8 +- base/comm/internals/psi_lovrl_upd.f90 | 8 +- base/comm/internals/psi_lswapdata.F90 | 30 ++-- base/comm/internals/psi_lswaptran.F90 | 28 +-- base/comm/internals/psi_movrl_restr_a.f90 | 6 +- base/comm/internals/psi_movrl_save_a.f90 | 6 +- base/comm/internals/psi_movrl_upd_a.f90 | 7 +- base/comm/internals/psi_mswapdata_a.F90 | 34 ++-- base/comm/internals/psi_mswaptran_a.F90 | 30 ++-- base/comm/internals/psi_sovrl_restr.f90 | 6 +- base/comm/internals/psi_sovrl_restr_a.f90 | 6 +- base/comm/internals/psi_sovrl_save.f90 | 8 +- base/comm/internals/psi_sovrl_save_a.f90 | 6 +- base/comm/internals/psi_sovrl_upd.f90 | 8 +- base/comm/internals/psi_sovrl_upd_a.f90 | 7 +- base/comm/internals/psi_sswapdata.F90 | 30 ++-- base/comm/internals/psi_sswapdata_a.F90 | 34 ++-- base/comm/internals/psi_sswaptran.F90 | 28 +-- base/comm/internals/psi_sswaptran_a.F90 | 30 ++-- base/comm/internals/psi_zovrl_restr.f90 | 6 +- base/comm/internals/psi_zovrl_restr_a.f90 | 6 +- base/comm/internals/psi_zovrl_save.f90 | 8 +- base/comm/internals/psi_zovrl_save_a.f90 | 6 +- base/comm/internals/psi_zovrl_upd.f90 | 8 +- base/comm/internals/psi_zovrl_upd_a.f90 | 7 +- base/comm/internals/psi_zswapdata.F90 | 30 ++-- base/comm/internals/psi_zswapdata_a.F90 | 34 ++-- base/comm/internals/psi_zswaptran.F90 | 28 +-- base/comm/internals/psi_zswaptran_a.F90 | 30 ++-- base/comm/psb_cgather.f90 | 10 +- base/comm/psb_cgather_a.f90 | 13 +- base/comm/psb_chalo.f90 | 10 +- base/comm/psb_chalo_a.f90 | 10 +- base/comm/psb_covrl.f90 | 10 +- base/comm/psb_covrl_a.f90 | 10 +- base/comm/psb_cscatter.F90 | 5 +- base/comm/psb_cscatter_a.F90 | 10 +- base/comm/psb_cspgather.F90 | 15 +- base/comm/psb_dgather.f90 | 10 +- base/comm/psb_dgather_a.f90 | 13 +- base/comm/psb_dhalo.f90 | 10 +- base/comm/psb_dhalo_a.f90 | 10 +- base/comm/psb_dovrl.f90 | 10 +- base/comm/psb_dovrl_a.f90 | 10 +- base/comm/psb_dscatter.F90 | 5 +- base/comm/psb_dscatter_a.F90 | 10 +- base/comm/psb_dspgather.F90 | 15 +- base/comm/psb_egather_a.f90 | 13 +- base/comm/psb_ehalo_a.f90 | 10 +- base/comm/psb_eovrl_a.f90 | 10 +- base/comm/psb_escatter_a.F90 | 10 +- base/comm/psb_i2gather_a.f90 | 13 +- base/comm/psb_i2halo_a.f90 | 10 +- base/comm/psb_i2ovrl_a.f90 | 10 +- base/comm/psb_i2scatter_a.F90 | 10 +- base/comm/psb_igather.f90 | 10 +- base/comm/psb_ihalo.f90 | 10 +- base/comm/psb_iovrl.f90 | 10 +- base/comm/psb_iscatter.F90 | 5 +- base/comm/psb_ispgather.F90 | 15 +- base/comm/psb_lgather.f90 | 10 +- base/comm/psb_lhalo.f90 | 10 +- base/comm/psb_lovrl.f90 | 10 +- base/comm/psb_lscatter.F90 | 5 +- base/comm/psb_lspgather.F90 | 15 +- base/comm/psb_mgather_a.f90 | 13 +- base/comm/psb_mhalo_a.f90 | 10 +- base/comm/psb_movrl_a.f90 | 10 +- base/comm/psb_mscatter_a.F90 | 10 +- base/comm/psb_sgather.f90 | 10 +- base/comm/psb_sgather_a.f90 | 13 +- base/comm/psb_shalo.f90 | 10 +- base/comm/psb_shalo_a.f90 | 10 +- base/comm/psb_sovrl.f90 | 10 +- base/comm/psb_sovrl_a.f90 | 10 +- base/comm/psb_sscatter.F90 | 5 +- base/comm/psb_sscatter_a.F90 | 10 +- base/comm/psb_sspgather.F90 | 15 +- base/comm/psb_zgather.f90 | 10 +- base/comm/psb_zgather_a.f90 | 13 +- base/comm/psb_zhalo.f90 | 10 +- base/comm/psb_zhalo_a.f90 | 10 +- base/comm/psb_zovrl.f90 | 10 +- base/comm/psb_zovrl_a.f90 | 10 +- base/comm/psb_zscatter.F90 | 5 +- base/comm/psb_zscatter_a.F90 | 10 +- base/comm/psb_zspgather.F90 | 15 +- base/internals/Makefile | 4 +- base/internals/psi_a2a_fnd_owner.F90 | 14 +- base/internals/psi_adjcncy_fnd_owner.F90 | 7 +- base/internals/psi_bld_glb_dep_list.F90 | 186 ++++++++++---------- base/internals/psi_bld_tmphalo.f90 | 3 +- base/internals/psi_bld_tmpovrl.f90 | 4 +- base/internals/psi_compute_size.f90 | 3 +- base/internals/psi_crea_index.f90 | 11 +- base/internals/psi_crea_ovr_elem.f90 | 1 - base/internals/psi_desc_impl.f90 | 5 +- base/internals/psi_desc_index.F90 | 2 +- base/internals/psi_extrct_dl.F90 | 27 +-- base/internals/psi_fnd_owner.F90 | 3 +- base/internals/psi_graph_fnd_owner.F90 | 10 +- base/internals/psi_indx_map_fnd_owner.F90 | 6 +- base/internals/psi_sort_dl.f90 | 4 +- base/internals/psi_symm_dep_list.F90 | 17 +- base/internals/psi_xtr_loc_dl.F90 | 13 +- base/modules/Makefile | 86 ++++----- base/modules/comm/psb_c_comm_a_mod.f90 | 8 +- base/modules/comm/psb_d_comm_a_mod.f90 | 8 +- base/modules/comm/psb_e_comm_a_mod.f90 | 8 +- base/modules/comm/psb_i2_comm_a_mod.f90 | 8 +- base/modules/comm/psb_m_comm_a_mod.f90 | 8 +- base/modules/comm/psb_s_comm_a_mod.f90 | 8 +- base/modules/comm/psb_z_comm_a_mod.f90 | 8 +- base/modules/comm/psi_c_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_c_comm_v_mod.f90 | 33 ++-- base/modules/comm/psi_d_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_d_comm_v_mod.f90 | 33 ++-- base/modules/comm/psi_e_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_i2_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_i_comm_v_mod.f90 | 31 ++-- base/modules/comm/psi_l_comm_v_mod.f90 | 31 ++-- base/modules/comm/psi_m_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_s_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_s_comm_v_mod.f90 | 33 ++-- base/modules/comm/psi_z_comm_a_mod.f90 | 47 +++-- base/modules/comm/psi_z_comm_v_mod.f90 | 33 ++-- base/modules/desc/psb_desc_mod.F90 | 165 ++++++++--------- base/modules/desc/psb_gen_block_map_mod.F90 | 20 ++- base/modules/desc/psb_glist_map_mod.f90 | 9 +- base/modules/desc/psb_hash_map_mod.f90 | 41 +++-- base/modules/desc/psb_indx_map_mod.f90 | 36 ++-- base/modules/desc/psb_list_map_mod.f90 | 11 +- base/modules/desc/psb_repl_map_mod.f90 | 12 +- base/modules/error.f90 | 34 +--- base/modules/penv/psi_penv_mod.F90 | 18 -- base/modules/psb_cbind_const_mod.F90 | 2 +- base/modules/psb_const_mod.F90 | 19 ++ base/modules/psb_error_impl.F90 | 41 +++-- base/modules/psb_error_mod.F90 | 26 +-- base/modules/psb_timers_mod.f90 | 4 +- base/modules/psi_i_mod.F90 | 40 ++--- base/modules/tools/psb_cd_tools_mod.F90 | 5 +- base/psblas/psb_cabs_vect.f90 | 3 +- base/psblas/psb_camax.f90 | 15 +- base/psblas/psb_casum.f90 | 12 +- base/psblas/psb_caxpby.f90 | 18 +- base/psblas/psb_ccmp_vect.f90 | 9 +- base/psblas/psb_cdiv_vect.f90 | 12 +- base/psblas/psb_cdot.f90 | 15 +- base/psblas/psb_cgetmatinfo.f90 | 3 +- base/psblas/psb_cinv_vect.f90 | 6 +- base/psblas/psb_cmlt_vect.f90 | 6 +- base/psblas/psb_cnrm2.f90 | 18 +- base/psblas/psb_cnrmi.f90 | 3 +- base/psblas/psb_cspmm.f90 | 9 +- base/psblas/psb_cspnrm1.f90 | 3 +- base/psblas/psb_cspsm.f90 | 9 +- base/psblas/psb_dabs_vect.f90 | 3 +- base/psblas/psb_damax.f90 | 18 +- base/psblas/psb_dasum.f90 | 12 +- base/psblas/psb_daxpby.f90 | 18 +- base/psblas/psb_dcmp_vect.f90 | 12 +- base/psblas/psb_ddiv_vect.f90 | 15 +- base/psblas/psb_ddot.f90 | 15 +- base/psblas/psb_dgetmatinfo.f90 | 3 +- base/psblas/psb_dinv_vect.f90 | 6 +- base/psblas/psb_dmlt_vect.f90 | 6 +- base/psblas/psb_dnrm2.f90 | 18 +- base/psblas/psb_dnrmi.f90 | 3 +- base/psblas/psb_dspmm.f90 | 9 +- base/psblas/psb_dspnrm1.f90 | 3 +- base/psblas/psb_dspsm.f90 | 9 +- base/psblas/psb_sabs_vect.f90 | 3 +- base/psblas/psb_samax.f90 | 18 +- base/psblas/psb_sasum.f90 | 12 +- base/psblas/psb_saxpby.f90 | 18 +- base/psblas/psb_scmp_vect.f90 | 12 +- base/psblas/psb_sdiv_vect.f90 | 15 +- base/psblas/psb_sdot.f90 | 15 +- base/psblas/psb_sgetmatinfo.f90 | 3 +- base/psblas/psb_sinv_vect.f90 | 6 +- base/psblas/psb_smlt_vect.f90 | 6 +- base/psblas/psb_snrm2.f90 | 18 +- base/psblas/psb_snrmi.f90 | 3 +- base/psblas/psb_sspmm.f90 | 9 +- base/psblas/psb_sspnrm1.f90 | 3 +- base/psblas/psb_sspsm.f90 | 9 +- base/psblas/psb_zabs_vect.f90 | 3 +- base/psblas/psb_zamax.f90 | 15 +- base/psblas/psb_zasum.f90 | 12 +- base/psblas/psb_zaxpby.f90 | 18 +- base/psblas/psb_zcmp_vect.f90 | 9 +- base/psblas/psb_zdiv_vect.f90 | 12 +- base/psblas/psb_zdot.f90 | 15 +- base/psblas/psb_zgetmatinfo.f90 | 3 +- base/psblas/psb_zinv_vect.f90 | 6 +- base/psblas/psb_zmlt_vect.f90 | 6 +- base/psblas/psb_znrm2.f90 | 18 +- base/psblas/psb_znrmi.f90 | 3 +- base/psblas/psb_zspmm.f90 | 9 +- base/psblas/psb_zspnrm1.f90 | 3 +- base/psblas/psb_zspsm.f90 | 9 +- base/tools/psb_c_glob_transpose.F90 | 18 +- base/tools/psb_c_map.f90 | 12 +- base/tools/psb_c_par_csr_spspmm.f90 | 6 +- base/tools/psb_callc.f90 | 8 +- base/tools/psb_callc_a.f90 | 6 +- base/tools/psb_casb.f90 | 9 +- base/tools/psb_casb_a.f90 | 6 +- base/tools/psb_ccdbldext.F90 | 6 +- base/tools/psb_cd_inloc.f90 | 10 +- base/tools/psb_cd_lstext.f90 | 11 +- base/tools/psb_cd_reinit.f90 | 9 +- base/tools/psb_cd_renum_block.F90 | 9 +- base/tools/psb_cd_set_bld.f90 | 5 +- base/tools/psb_cd_switch_ovl_indxmap.f90 | 7 +- base/tools/psb_cdall.f90 | 29 +-- base/tools/psb_cdals.f90 | 10 +- base/tools/psb_cdalv.f90 | 7 +- base/tools/psb_cdcpy.F90 | 19 +- base/tools/psb_cdins.F90 | 19 +- base/tools/psb_cdprt.f90 | 14 +- base/tools/psb_cdren.f90 | 11 +- base/tools/psb_cdrep.f90 | 152 ++++++++-------- base/tools/psb_cfree.f90 | 9 +- base/tools/psb_cfree_a.f90 | 6 +- base/tools/psb_cgetelem.f90 | 3 +- base/tools/psb_cins.f90 | 12 +- base/tools/psb_cins_a.f90 | 6 +- base/tools/psb_cspalloc.f90 | 3 +- base/tools/psb_cspasb.f90 | 3 +- base/tools/psb_cspfree.f90 | 3 +- base/tools/psb_csphalo.F90 | 12 +- base/tools/psb_cspins.F90 | 15 +- base/tools/psb_csprn.f90 | 3 +- base/tools/psb_d_glob_transpose.F90 | 18 +- base/tools/psb_d_map.f90 | 12 +- base/tools/psb_d_par_csr_spspmm.f90 | 6 +- base/tools/psb_dallc.f90 | 8 +- base/tools/psb_dallc_a.f90 | 6 +- base/tools/psb_dasb.f90 | 9 +- base/tools/psb_dasb_a.f90 | 6 +- base/tools/psb_dcdbldext.F90 | 6 +- base/tools/psb_dfree.f90 | 9 +- base/tools/psb_dfree_a.f90 | 6 +- base/tools/psb_dgetelem.f90 | 3 +- base/tools/psb_dins.f90 | 12 +- base/tools/psb_dins_a.f90 | 6 +- base/tools/psb_dspalloc.f90 | 3 +- base/tools/psb_dspasb.f90 | 3 +- base/tools/psb_dspfree.f90 | 3 +- base/tools/psb_dsphalo.F90 | 12 +- base/tools/psb_dspins.F90 | 15 +- base/tools/psb_dsprn.f90 | 3 +- base/tools/psb_eallc_a.f90 | 6 +- base/tools/psb_easb_a.f90 | 6 +- base/tools/psb_efree_a.f90 | 6 +- base/tools/psb_eins_a.f90 | 6 +- base/tools/psb_get_overlap.f90 | 4 +- base/tools/psb_glob_to_loc.f90 | 6 +- base/tools/psb_i2allc_a.f90 | 6 +- base/tools/psb_i2asb_a.f90 | 6 +- base/tools/psb_i2free_a.f90 | 6 +- base/tools/psb_i2ins_a.f90 | 6 +- base/tools/psb_iallc.f90 | 8 +- base/tools/psb_iasb.f90 | 9 +- base/tools/psb_icdasb.F90 | 6 +- base/tools/psb_ifree.f90 | 9 +- base/tools/psb_iins.f90 | 12 +- base/tools/psb_lallc.f90 | 8 +- base/tools/psb_lasb.f90 | 9 +- base/tools/psb_lfree.f90 | 9 +- base/tools/psb_lins.f90 | 12 +- base/tools/psb_mallc_a.f90 | 6 +- base/tools/psb_masb_a.f90 | 6 +- base/tools/psb_mfree_a.f90 | 6 +- base/tools/psb_mins_a.f90 | 6 +- base/tools/psb_s_glob_transpose.F90 | 18 +- base/tools/psb_s_map.f90 | 12 +- base/tools/psb_s_par_csr_spspmm.f90 | 6 +- base/tools/psb_sallc.f90 | 8 +- base/tools/psb_sallc_a.f90 | 6 +- base/tools/psb_sasb.f90 | 9 +- base/tools/psb_sasb_a.f90 | 6 +- base/tools/psb_scdbldext.F90 | 6 +- base/tools/psb_sfree.f90 | 9 +- base/tools/psb_sfree_a.f90 | 6 +- base/tools/psb_sgetelem.f90 | 3 +- base/tools/psb_sins.f90 | 12 +- base/tools/psb_sins_a.f90 | 6 +- base/tools/psb_sspalloc.f90 | 3 +- base/tools/psb_sspasb.f90 | 3 +- base/tools/psb_sspfree.f90 | 3 +- base/tools/psb_ssphalo.F90 | 12 +- base/tools/psb_sspins.F90 | 15 +- base/tools/psb_ssprn.f90 | 3 +- base/tools/psb_z_glob_transpose.F90 | 18 +- base/tools/psb_z_map.f90 | 12 +- base/tools/psb_z_par_csr_spspmm.f90 | 6 +- base/tools/psb_zallc.f90 | 8 +- base/tools/psb_zallc_a.f90 | 6 +- base/tools/psb_zasb.f90 | 9 +- base/tools/psb_zasb_a.f90 | 6 +- base/tools/psb_zcdbldext.F90 | 6 +- base/tools/psb_zfree.f90 | 9 +- base/tools/psb_zfree_a.f90 | 6 +- base/tools/psb_zgetelem.f90 | 3 +- base/tools/psb_zins.f90 | 12 +- base/tools/psb_zins_a.f90 | 6 +- base/tools/psb_zspalloc.f90 | 3 +- base/tools/psb_zspasb.f90 | 3 +- base/tools/psb_zspfree.f90 | 3 +- base/tools/psb_zsphalo.F90 | 12 +- base/tools/psb_zspins.F90 | 15 +- base/tools/psb_zsprn.f90 | 3 +- cbind/base/psb_base_tools_cbind_mod.F90 | 21 ++- cbind/base/psb_cpenv_mod.f90 | 111 +++++++----- cbind/prec/psb_cprec_cbind_mod.f90 | 4 +- cbind/prec/psb_dprec_cbind_mod.f90 | 4 +- cbind/prec/psb_sprec_cbind_mod.f90 | 4 +- cbind/prec/psb_zprec_cbind_mod.f90 | 4 +- krylov/psb_base_krylov_conv_mod.f90 | 3 +- krylov/psb_c_krylov_conv_mod.f90 | 12 +- krylov/psb_cbicg.f90 | 3 +- krylov/psb_ccg.F90 | 3 +- krylov/psb_ccgs.f90 | 3 +- krylov/psb_ccgstab.f90 | 3 +- krylov/psb_ccgstabl.f90 | 3 +- krylov/psb_cfcg.F90 | 3 +- krylov/psb_cgcr.f90 | 3 +- krylov/psb_ckrylov.f90 | 3 +- krylov/psb_crgmres.f90 | 3 +- krylov/psb_d_krylov_conv_mod.f90 | 12 +- krylov/psb_dbicg.f90 | 3 +- krylov/psb_dcg.F90 | 3 +- krylov/psb_dcgs.f90 | 3 +- krylov/psb_dcgstab.f90 | 3 +- krylov/psb_dcgstabl.f90 | 3 +- krylov/psb_dfcg.F90 | 3 +- krylov/psb_dgcr.f90 | 3 +- krylov/psb_dkrylov.f90 | 3 +- krylov/psb_drgmres.f90 | 3 +- krylov/psb_s_krylov_conv_mod.f90 | 12 +- krylov/psb_sbicg.f90 | 3 +- krylov/psb_scg.F90 | 3 +- krylov/psb_scgs.f90 | 3 +- krylov/psb_scgstab.f90 | 3 +- krylov/psb_scgstabl.f90 | 3 +- krylov/psb_sfcg.F90 | 3 +- krylov/psb_sgcr.f90 | 3 +- krylov/psb_skrylov.f90 | 3 +- krylov/psb_srgmres.f90 | 3 +- krylov/psb_z_krylov_conv_mod.f90 | 12 +- krylov/psb_zbicg.f90 | 3 +- krylov/psb_zcg.F90 | 3 +- krylov/psb_zcgs.f90 | 3 +- krylov/psb_zcgstab.f90 | 3 +- krylov/psb_zcgstabl.f90 | 3 +- krylov/psb_zfcg.F90 | 3 +- krylov/psb_zgcr.f90 | 3 +- krylov/psb_zkrylov.f90 | 3 +- krylov/psb_zrgmres.f90 | 3 +- prec/impl/psb_c_bjacprec_impl.f90 | 12 +- prec/impl/psb_c_diagprec_impl.f90 | 3 +- prec/impl/psb_c_prec_type_impl.f90 | 14 +- prec/impl/psb_cprecbld.f90 | 3 +- prec/impl/psb_cprecinit.f90 | 2 +- prec/impl/psb_d_bjacprec_impl.f90 | 12 +- prec/impl/psb_d_diagprec_impl.f90 | 3 +- prec/impl/psb_d_prec_type_impl.f90 | 14 +- prec/impl/psb_dprecbld.f90 | 3 +- prec/impl/psb_dprecinit.f90 | 2 +- prec/impl/psb_s_bjacprec_impl.f90 | 12 +- prec/impl/psb_s_diagprec_impl.f90 | 3 +- prec/impl/psb_s_prec_type_impl.f90 | 14 +- prec/impl/psb_sprecbld.f90 | 3 +- prec/impl/psb_sprecinit.f90 | 2 +- prec/impl/psb_z_bjacprec_impl.f90 | 12 +- prec/impl/psb_z_diagprec_impl.f90 | 3 +- prec/impl/psb_z_prec_type_impl.f90 | 14 +- prec/impl/psb_zprecbld.f90 | 3 +- prec/impl/psb_zprecinit.f90 | 2 +- prec/psb_c_base_prec_mod.f90 | 14 +- prec/psb_c_bjacprec.f90 | 3 +- prec/psb_c_diagprec.f90 | 3 +- prec/psb_c_nullprec.f90 | 6 +- prec/psb_c_prec_type.f90 | 6 +- prec/psb_d_base_prec_mod.f90 | 14 +- prec/psb_d_bjacprec.f90 | 3 +- prec/psb_d_diagprec.f90 | 3 +- prec/psb_d_nullprec.f90 | 6 +- prec/psb_d_prec_type.f90 | 6 +- prec/psb_s_base_prec_mod.f90 | 14 +- prec/psb_s_bjacprec.f90 | 3 +- prec/psb_s_diagprec.f90 | 3 +- prec/psb_s_nullprec.f90 | 6 +- prec/psb_s_prec_type.f90 | 6 +- prec/psb_z_base_prec_mod.f90 | 14 +- prec/psb_z_bjacprec.f90 | 3 +- prec/psb_z_diagprec.f90 | 3 +- prec/psb_z_nullprec.f90 | 6 +- prec/psb_z_prec_type.f90 | 6 +- test/cdasb/psb_d_pde3d.f90 | 8 +- test/fileread/getp.f90 | 4 +- test/fileread/psb_cf_sample.f90 | 3 +- test/fileread/psb_df_sample.f90 | 3 +- test/fileread/psb_sf_sample.f90 | 3 +- test/fileread/psb_zf_sample.f90 | 3 +- test/hello/hello.f90 | 3 +- test/hello/pingpong.f90 | 3 +- test/kernel/d_file_spmv.f90 | 3 +- test/kernel/pdgenspmv.f90 | 8 +- test/kernel/s_file_spmv.f90 | 3 +- test/kernel/vecoperation.f90 | 10 +- test/pargen/psb_d_pde2d.f90 | 8 +- test/pargen/psb_d_pde3d.f90 | 8 +- test/pargen/psb_s_pde2d.f90 | 8 +- test/pargen/psb_s_pde3d.f90 | 8 +- test/serial/d_matgen.F90 | 8 +- test/torture/psb_c_mvsv_tester.f90 | 108 ++++++++---- test/torture/psb_d_mvsv_tester.f90 | 108 ++++++++---- test/torture/psb_s_mvsv_tester.f90 | 108 ++++++++---- test/torture/psb_z_mvsv_tester.f90 | 108 ++++++++---- util/psb_c_mat_dist_impl.f90 | 4 +- util/psb_c_mat_dist_mod.f90 | 13 +- util/psb_d_mat_dist_impl.f90 | 4 +- util/psb_d_mat_dist_mod.f90 | 13 +- util/psb_metispart_mod.F90 | 5 +- util/psb_s_mat_dist_impl.f90 | 4 +- util/psb_s_mat_dist_mod.f90 | 13 +- util/psb_z_mat_dist_impl.f90 | 4 +- util/psb_z_mat_dist_mod.f90 | 13 +- 468 files changed, 3617 insertions(+), 2325 deletions(-) diff --git a/base/comm/internals/psi_covrl_restr.f90 b/base/comm/internals/psi_covrl_restr.f90 index 996e85ad..a409dfd9 100644 --- a/base/comm/internals/psi_covrl_restr.f90 +++ b/base/comm/internals/psi_covrl_restr.f90 @@ -47,7 +47,8 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_covrl_restr_vect' @@ -89,7 +90,8 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_covrl_restr_mv' diff --git a/base/comm/internals/psi_covrl_restr_a.f90 b/base/comm/internals/psi_covrl_restr_a.f90 index 3c814a81..801e59cc 100644 --- a/base/comm/internals/psi_covrl_restr_a.f90 +++ b/base/comm/internals/psi_covrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_covrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_covrl_restrr2' diff --git a/base/comm/internals/psi_covrl_save.f90 b/base/comm/internals/psi_covrl_save.f90 index c48d2ade..9dd60edd 100644 --- a/base/comm/internals/psi_covrl_save.f90 +++ b/base/comm/internals/psi_covrl_save.f90 @@ -47,7 +47,8 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -82,8 +83,6 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) return end subroutine psi_covrl_save_vect - - subroutine psi_covrl_save_multivect(x,xs,desc_a,info) use psi_mod, psi_protect_name => psi_covrl_save_multivect use psb_realloc_mod @@ -97,7 +96,8 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_covrl_save_a.f90 b/base/comm/internals/psi_covrl_save_a.f90 index d017d921..8607df7a 100644 --- a/base/comm/internals/psi_covrl_save_a.f90 +++ b/base/comm/internals/psi_covrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_covrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_covrl_saver2' diff --git a/base/comm/internals/psi_covrl_upd.f90 b/base/comm/internals/psi_covrl_upd.f90 index ce33845e..d3c8a5c0 100644 --- a/base/comm/internals/psi_covrl_upd.f90 +++ b/base/comm/internals/psi_covrl_upd.f90 @@ -32,7 +32,7 @@ ! Subroutine: psi_covrl_update ! These subroutines update the overlap region of a vector; they are used ! for the transpose matrix-vector product when there is a nonempty overlap, -! or for the application of Additive Schwarz preconditioners. +! or for the application of Additive Schwarz preconditioners. ! ! ! @@ -50,7 +50,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -131,7 +132,8 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:,:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_covrl_upd_a.f90 b/base/comm/internals/psi_covrl_upd_a.f90 index 33297731..7483a4fd 100644 --- a/base/comm/internals/psi_covrl_upd_a.f90 +++ b/base/comm/internals/psi_covrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) return end subroutine psi_covrl_updr1 - subroutine psi_covrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_covrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_cswapdata.F90 b/base/comm/internals/psi_cswapdata.F90 index fed8afbf..d416a6ff 100644 --- a/base/comm/internals/psi_cswapdata.F90 +++ b/base/comm/internals/psi_cswapdata.F90 @@ -113,7 +113,9 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -190,8 +192,10 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_c_base_vect_type) :: y complex(psb_spk_) :: beta complex(psb_spk_), target :: work(:) @@ -199,7 +203,8 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -413,7 +418,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_cswap_vidx_vect @@ -450,7 +455,9 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -527,8 +534,10 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_c_base_multivect_type) :: y complex(psb_spk_) :: beta complex(psb_spk_), target :: work(:) @@ -536,7 +545,8 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -756,7 +766,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_cswap_vidx_multivect diff --git a/base/comm/internals/psi_cswapdata_a.F90 b/base/comm/internals/psi_cswapdata_a.F90 index 37d019d6..e627a4b0 100644 --- a/base/comm/internals/psi_cswapdata_a.F90 +++ b/base/comm/internals/psi_cswapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_cswapdatam -subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_cswapidxm @@ -167,14 +169,17 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_cswapidxm @@ -579,7 +582,9 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:), beta complex(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_cswapidxv diff --git a/base/comm/internals/psi_cswaptran.F90 b/base/comm/internals/psi_cswaptran.F90 index 152cb045..9d87156f 100644 --- a/base/comm/internals/psi_cswaptran.F90 +++ b/base/comm/internals/psi_cswaptran.F90 @@ -115,7 +115,9 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -161,8 +163,6 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) return end subroutine psi_cswaptran_vect - - ! ! ! Subroutine: psi_ctran_vidx_vect @@ -193,7 +193,9 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_c_base_vect_type) :: y complex(psb_spk_) :: beta @@ -202,7 +204,8 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -422,7 +425,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -463,7 +466,9 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -540,7 +545,9 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_c_base_multivect_type) :: y complex(psb_spk_) :: beta @@ -549,7 +556,8 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -773,7 +781,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/internals/psi_cswaptran_a.F90 b/base/comm/internals/psi_cswaptran_a.F90 index f43e3be3..6792be29 100644 --- a/base/comm/internals/psi_cswaptran_a.F90 +++ b/base/comm/internals/psi_cswaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_ctranidxm @@ -592,7 +597,9 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:), beta complex(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_ctranidxv diff --git a/base/comm/internals/psi_dovrl_restr.f90 b/base/comm/internals/psi_dovrl_restr.f90 index 1d6695cc..5ed758ed 100644 --- a/base/comm/internals/psi_dovrl_restr.f90 +++ b/base/comm/internals/psi_dovrl_restr.f90 @@ -47,7 +47,8 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_restr_vect' @@ -89,7 +90,8 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_restr_mv' diff --git a/base/comm/internals/psi_dovrl_restr_a.f90 b/base/comm/internals/psi_dovrl_restr_a.f90 index df47403b..7cd9e32b 100644 --- a/base/comm/internals/psi_dovrl_restr_a.f90 +++ b/base/comm/internals/psi_dovrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_restrr2' diff --git a/base/comm/internals/psi_dovrl_save.f90 b/base/comm/internals/psi_dovrl_save.f90 index 0689ee1b..a701a239 100644 --- a/base/comm/internals/psi_dovrl_save.f90 +++ b/base/comm/internals/psi_dovrl_save.f90 @@ -47,7 +47,8 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -82,8 +83,6 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) return end subroutine psi_dovrl_save_vect - - subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) use psi_mod, psi_protect_name => psi_dovrl_save_multivect use psb_realloc_mod @@ -97,7 +96,8 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_dovrl_save_a.f90 b/base/comm/internals/psi_dovrl_save_a.f90 index fcc19e08..b214c9a6 100644 --- a/base/comm/internals/psi_dovrl_save_a.f90 +++ b/base/comm/internals/psi_dovrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver2' diff --git a/base/comm/internals/psi_dovrl_upd.f90 b/base/comm/internals/psi_dovrl_upd.f90 index efbb2495..20fb80f1 100644 --- a/base/comm/internals/psi_dovrl_upd.f90 +++ b/base/comm/internals/psi_dovrl_upd.f90 @@ -32,7 +32,7 @@ ! Subroutine: psi_dovrl_update ! These subroutines update the overlap region of a vector; they are used ! for the transpose matrix-vector product when there is a nonempty overlap, -! or for the application of Additive Schwarz preconditioners. +! or for the application of Additive Schwarz preconditioners. ! ! ! @@ -50,7 +50,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -131,7 +132,8 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:,:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_dovrl_upd_a.f90 b/base/comm/internals/psi_dovrl_upd_a.f90 index 8ad3db6b..f3fb3da9 100644 --- a/base/comm/internals/psi_dovrl_upd_a.f90 +++ b/base/comm/internals/psi_dovrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) return end subroutine psi_dovrl_updr1 - subroutine psi_dovrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_dovrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_dswapdata.F90 b/base/comm/internals/psi_dswapdata.F90 index a59b9b79..0f28408b 100644 --- a/base/comm/internals/psi_dswapdata.F90 +++ b/base/comm/internals/psi_dswapdata.F90 @@ -113,7 +113,9 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -190,8 +192,10 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_d_base_vect_type) :: y real(psb_dpk_) :: beta real(psb_dpk_), target :: work(:) @@ -199,7 +203,8 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -413,7 +418,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_dswap_vidx_vect @@ -450,7 +455,9 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -527,8 +534,10 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_d_base_multivect_type) :: y real(psb_dpk_) :: beta real(psb_dpk_), target :: work(:) @@ -536,7 +545,8 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -756,7 +766,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_dswap_vidx_multivect diff --git a/base/comm/internals/psi_dswapdata_a.F90 b/base/comm/internals/psi_dswapdata_a.F90 index 7400548a..65090ee7 100644 --- a/base/comm/internals/psi_dswapdata_a.F90 +++ b/base/comm/internals/psi_dswapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_dswapdatam -subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dswapidxm @@ -167,14 +169,17 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_dswapidxm @@ -579,7 +582,9 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:), beta real(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_dswapidxv diff --git a/base/comm/internals/psi_dswaptran.F90 b/base/comm/internals/psi_dswaptran.F90 index 1feee33c..e3a784f4 100644 --- a/base/comm/internals/psi_dswaptran.F90 +++ b/base/comm/internals/psi_dswaptran.F90 @@ -115,7 +115,9 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -161,8 +163,6 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) return end subroutine psi_dswaptran_vect - - ! ! ! Subroutine: psi_dtran_vidx_vect @@ -193,7 +193,9 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_d_base_vect_type) :: y real(psb_dpk_) :: beta @@ -202,7 +204,8 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -422,7 +425,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -463,7 +466,9 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -540,7 +545,9 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_d_base_multivect_type) :: y real(psb_dpk_) :: beta @@ -549,7 +556,8 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -773,7 +781,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/internals/psi_dswaptran_a.F90 b/base/comm/internals/psi_dswaptran_a.F90 index cce55b4d..56691df5 100644 --- a/base/comm/internals/psi_dswaptran_a.F90 +++ b/base/comm/internals/psi_dswaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_dtranidxm @@ -592,7 +597,9 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:), beta real(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_dtranidxv diff --git a/base/comm/internals/psi_eovrl_restr_a.f90 b/base/comm/internals/psi_eovrl_restr_a.f90 index 3dbb2ac4..032844d9 100644 --- a/base/comm/internals/psi_eovrl_restr_a.f90 +++ b/base/comm/internals/psi_eovrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_eovrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_eovrl_restrr2' diff --git a/base/comm/internals/psi_eovrl_save_a.f90 b/base/comm/internals/psi_eovrl_save_a.f90 index 4f0b7d30..43bd5c9f 100644 --- a/base/comm/internals/psi_eovrl_save_a.f90 +++ b/base/comm/internals/psi_eovrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_eovrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_eovrl_saver2' diff --git a/base/comm/internals/psi_eovrl_upd_a.f90 b/base/comm/internals/psi_eovrl_upd_a.f90 index e8e40738..2790f57c 100644 --- a/base/comm/internals/psi_eovrl_upd_a.f90 +++ b/base/comm/internals/psi_eovrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info) return end subroutine psi_eovrl_updr1 - subroutine psi_eovrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_eovrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_eswapdata_a.F90 b/base/comm/internals/psi_eswapdata_a.F90 index aa0cda65..11f90f84 100644 --- a/base/comm/internals/psi_eswapdata_a.F90 +++ b/base/comm/internals/psi_eswapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_eswapdatam -subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_eswapidxm @@ -167,14 +169,17 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_eswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_eswapidxm @@ -579,7 +582,9 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:), beta integer(psb_epk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_eswapidxv diff --git a/base/comm/internals/psi_eswaptran_a.F90 b/base/comm/internals/psi_eswaptran_a.F90 index 0df27a5d..01251a4b 100644 --- a/base/comm/internals/psi_eswaptran_a.F90 +++ b/base/comm/internals/psi_eswaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_etranidxm @@ -592,7 +597,9 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:), beta integer(psb_epk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_etranidxv diff --git a/base/comm/internals/psi_i2ovrl_restr_a.f90 b/base/comm/internals/psi_i2ovrl_restr_a.f90 index 36bc2566..dbed16ab 100644 --- a/base/comm/internals/psi_i2ovrl_restr_a.f90 +++ b/base/comm/internals/psi_i2ovrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_i2ovrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_i2ovrl_restrr2' diff --git a/base/comm/internals/psi_i2ovrl_save_a.f90 b/base/comm/internals/psi_i2ovrl_save_a.f90 index 55e9ae89..fe30ab1f 100644 --- a/base/comm/internals/psi_i2ovrl_save_a.f90 +++ b/base/comm/internals/psi_i2ovrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_i2ovrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_i2ovrl_saver2' diff --git a/base/comm/internals/psi_i2ovrl_upd_a.f90 b/base/comm/internals/psi_i2ovrl_upd_a.f90 index c41803ef..ba6f900d 100644 --- a/base/comm/internals/psi_i2ovrl_upd_a.f90 +++ b/base/comm/internals/psi_i2ovrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info) return end subroutine psi_i2ovrl_updr1 - subroutine psi_i2ovrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_i2ovrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_i2swapdata_a.F90 b/base/comm/internals/psi_i2swapdata_a.F90 index 0140504d..82e15591 100644 --- a/base/comm/internals/psi_i2swapdata_a.F90 +++ b/base/comm/internals/psi_i2swapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_i2swapdatam -subroutine psi_i2swapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_i2swapidxm @@ -167,14 +169,17 @@ subroutine psi_i2swapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_i2swapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_i2swapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_i2swapidxm @@ -579,7 +582,9 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_i2swapidxv diff --git a/base/comm/internals/psi_i2swaptran_a.F90 b/base/comm/internals/psi_i2swaptran_a.F90 index 10531927..06f08cab 100644 --- a/base/comm/internals/psi_i2swaptran_a.F90 +++ b/base/comm/internals/psi_i2swaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_i2tranidxm @@ -592,7 +597,9 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_i2tranidxv diff --git a/base/comm/internals/psi_iovrl_restr.f90 b/base/comm/internals/psi_iovrl_restr.f90 index b0efa2ee..f407c91d 100644 --- a/base/comm/internals/psi_iovrl_restr.f90 +++ b/base/comm/internals/psi_iovrl_restr.f90 @@ -47,7 +47,8 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_iovrl_restr_vect' @@ -89,7 +90,8 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_iovrl_restr_mv' diff --git a/base/comm/internals/psi_iovrl_save.f90 b/base/comm/internals/psi_iovrl_save.f90 index cc7619f9..7ec0a0bc 100644 --- a/base/comm/internals/psi_iovrl_save.f90 +++ b/base/comm/internals/psi_iovrl_save.f90 @@ -47,7 +47,8 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -82,8 +83,6 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) return end subroutine psi_iovrl_save_vect - - subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) use psi_mod, psi_protect_name => psi_iovrl_save_multivect use psb_realloc_mod @@ -97,7 +96,8 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_iovrl_upd.f90 b/base/comm/internals/psi_iovrl_upd.f90 index 988bf006..1a26c87c 100644 --- a/base/comm/internals/psi_iovrl_upd.f90 +++ b/base/comm/internals/psi_iovrl_upd.f90 @@ -32,7 +32,7 @@ ! Subroutine: psi_iovrl_update ! These subroutines update the overlap region of a vector; they are used ! for the transpose matrix-vector product when there is a nonempty overlap, -! or for the application of Additive Schwarz preconditioners. +! or for the application of Additive Schwarz preconditioners. ! ! ! @@ -50,7 +50,8 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info) ! locals integer(psb_ipk_), allocatable :: xs(:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -131,7 +132,8 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info) ! locals integer(psb_ipk_), allocatable :: xs(:,:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_iswapdata.F90 b/base/comm/internals/psi_iswapdata.F90 index d05ab8ac..e9b8fa3d 100644 --- a/base/comm/internals/psi_iswapdata.F90 +++ b/base/comm/internals/psi_iswapdata.F90 @@ -113,7 +113,9 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -190,8 +192,10 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_i_base_vect_type) :: y integer(psb_ipk_) :: beta integer(psb_ipk_), target :: work(:) @@ -199,7 +203,8 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -413,7 +418,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_iswap_vidx_vect @@ -450,7 +455,9 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -527,8 +534,10 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_i_base_multivect_type) :: y integer(psb_ipk_) :: beta integer(psb_ipk_), target :: work(:) @@ -536,7 +545,8 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -756,7 +766,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_iswap_vidx_multivect diff --git a/base/comm/internals/psi_iswaptran.F90 b/base/comm/internals/psi_iswaptran.F90 index e5719735..21c37e5c 100644 --- a/base/comm/internals/psi_iswaptran.F90 +++ b/base/comm/internals/psi_iswaptran.F90 @@ -115,7 +115,9 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -161,8 +163,6 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) return end subroutine psi_iswaptran_vect - - ! ! ! Subroutine: psi_itran_vidx_vect @@ -193,7 +193,9 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_i_base_vect_type) :: y integer(psb_ipk_) :: beta @@ -202,7 +204,8 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -422,7 +425,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -463,7 +466,9 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -540,7 +545,9 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_i_base_multivect_type) :: y integer(psb_ipk_) :: beta @@ -549,7 +556,8 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -773,7 +781,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/internals/psi_lovrl_restr.f90 b/base/comm/internals/psi_lovrl_restr.f90 index dc33bbb1..2bb78d63 100644 --- a/base/comm/internals/psi_lovrl_restr.f90 +++ b/base/comm/internals/psi_lovrl_restr.f90 @@ -47,7 +47,8 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_lovrl_restr_vect' @@ -89,7 +90,8 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_lovrl_restr_mv' diff --git a/base/comm/internals/psi_lovrl_save.f90 b/base/comm/internals/psi_lovrl_save.f90 index 496eec90..3fceef89 100644 --- a/base/comm/internals/psi_lovrl_save.f90 +++ b/base/comm/internals/psi_lovrl_save.f90 @@ -47,7 +47,8 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -82,8 +83,6 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) return end subroutine psi_lovrl_save_vect - - subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) use psi_mod, psi_protect_name => psi_lovrl_save_multivect use psb_realloc_mod @@ -97,7 +96,8 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_lovrl_upd.f90 b/base/comm/internals/psi_lovrl_upd.f90 index d20d80cc..22837b89 100644 --- a/base/comm/internals/psi_lovrl_upd.f90 +++ b/base/comm/internals/psi_lovrl_upd.f90 @@ -32,7 +32,7 @@ ! Subroutine: psi_lovrl_update ! These subroutines update the overlap region of a vector; they are used ! for the transpose matrix-vector product when there is a nonempty overlap, -! or for the application of Additive Schwarz preconditioners. +! or for the application of Additive Schwarz preconditioners. ! ! ! @@ -50,7 +50,8 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info) ! locals integer(psb_lpk_), allocatable :: xs(:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -131,7 +132,8 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info) ! locals integer(psb_lpk_), allocatable :: xs(:,:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_lswapdata.F90 b/base/comm/internals/psi_lswapdata.F90 index 939f9596..6106659a 100644 --- a/base/comm/internals/psi_lswapdata.F90 +++ b/base/comm/internals/psi_lswapdata.F90 @@ -113,7 +113,9 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -190,8 +192,10 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_l_base_vect_type) :: y integer(psb_lpk_) :: beta integer(psb_lpk_), target :: work(:) @@ -199,7 +203,8 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -413,7 +418,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_lswap_vidx_vect @@ -450,7 +455,9 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -527,8 +534,10 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_l_base_multivect_type) :: y integer(psb_lpk_) :: beta integer(psb_lpk_), target :: work(:) @@ -536,7 +545,8 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -756,7 +766,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_lswap_vidx_multivect diff --git a/base/comm/internals/psi_lswaptran.F90 b/base/comm/internals/psi_lswaptran.F90 index ccc1b6e3..e0bf6c00 100644 --- a/base/comm/internals/psi_lswaptran.F90 +++ b/base/comm/internals/psi_lswaptran.F90 @@ -115,7 +115,9 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -161,8 +163,6 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data) return end subroutine psi_lswaptran_vect - - ! ! ! Subroutine: psi_ltran_vidx_vect @@ -193,7 +193,9 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_l_base_vect_type) :: y integer(psb_lpk_) :: beta @@ -202,7 +204,8 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -422,7 +425,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -463,7 +466,9 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -540,7 +545,9 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_l_base_multivect_type) :: y integer(psb_lpk_) :: beta @@ -549,7 +556,8 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -773,7 +781,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/internals/psi_movrl_restr_a.f90 b/base/comm/internals/psi_movrl_restr_a.f90 index 92e06793..92717599 100644 --- a/base/comm/internals/psi_movrl_restr_a.f90 +++ b/base/comm/internals/psi_movrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_movrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_movrl_restrr2' diff --git a/base/comm/internals/psi_movrl_save_a.f90 b/base/comm/internals/psi_movrl_save_a.f90 index fbc021cf..20c1d0e7 100644 --- a/base/comm/internals/psi_movrl_save_a.f90 +++ b/base/comm/internals/psi_movrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_movrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_movrl_saver2' diff --git a/base/comm/internals/psi_movrl_upd_a.f90 b/base/comm/internals/psi_movrl_upd_a.f90 index 03670659..a935452e 100644 --- a/base/comm/internals/psi_movrl_upd_a.f90 +++ b/base/comm/internals/psi_movrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_movrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_movrl_updr1(x,desc_a,update,info) return end subroutine psi_movrl_updr1 - subroutine psi_movrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_movrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_movrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_mswapdata_a.F90 b/base/comm/internals/psi_mswapdata_a.F90 index 32b8a64e..bf2908d5 100644 --- a/base/comm/internals/psi_mswapdata_a.F90 +++ b/base/comm/internals/psi_mswapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_mswapdatam -subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_mswapidxm @@ -167,14 +169,17 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_mswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_mswapidxm @@ -579,7 +582,9 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:), beta integer(psb_mpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_mswapidxv diff --git a/base/comm/internals/psi_mswaptran_a.F90 b/base/comm/internals/psi_mswaptran_a.F90 index 7b94d480..e04b5307 100644 --- a/base/comm/internals/psi_mswaptran_a.F90 +++ b/base/comm/internals/psi_mswaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_mtranidxm @@ -592,7 +597,9 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:), beta integer(psb_mpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_mtranidxv diff --git a/base/comm/internals/psi_sovrl_restr.f90 b/base/comm/internals/psi_sovrl_restr.f90 index 3854040c..d577da9c 100644 --- a/base/comm/internals/psi_sovrl_restr.f90 +++ b/base/comm/internals/psi_sovrl_restr.f90 @@ -47,7 +47,8 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_sovrl_restr_vect' @@ -89,7 +90,8 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_sovrl_restr_mv' diff --git a/base/comm/internals/psi_sovrl_restr_a.f90 b/base/comm/internals/psi_sovrl_restr_a.f90 index e66297d5..5cf91e35 100644 --- a/base/comm/internals/psi_sovrl_restr_a.f90 +++ b/base/comm/internals/psi_sovrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_sovrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_sovrl_restrr2' diff --git a/base/comm/internals/psi_sovrl_save.f90 b/base/comm/internals/psi_sovrl_save.f90 index 9b06fef7..39344e08 100644 --- a/base/comm/internals/psi_sovrl_save.f90 +++ b/base/comm/internals/psi_sovrl_save.f90 @@ -47,7 +47,8 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -82,8 +83,6 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) return end subroutine psi_sovrl_save_vect - - subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) use psi_mod, psi_protect_name => psi_sovrl_save_multivect use psb_realloc_mod @@ -97,7 +96,8 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_sovrl_save_a.f90 b/base/comm/internals/psi_sovrl_save_a.f90 index cf400127..4b78186f 100644 --- a/base/comm/internals/psi_sovrl_save_a.f90 +++ b/base/comm/internals/psi_sovrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_sovrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_sovrl_saver2' diff --git a/base/comm/internals/psi_sovrl_upd.f90 b/base/comm/internals/psi_sovrl_upd.f90 index 636261b1..fa08e0aa 100644 --- a/base/comm/internals/psi_sovrl_upd.f90 +++ b/base/comm/internals/psi_sovrl_upd.f90 @@ -32,7 +32,7 @@ ! Subroutine: psi_sovrl_update ! These subroutines update the overlap region of a vector; they are used ! for the transpose matrix-vector product when there is a nonempty overlap, -! or for the application of Additive Schwarz preconditioners. +! or for the application of Additive Schwarz preconditioners. ! ! ! @@ -50,7 +50,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -131,7 +132,8 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:,:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_sovrl_upd_a.f90 b/base/comm/internals/psi_sovrl_upd_a.f90 index 82211657..d8d91670 100644 --- a/base/comm/internals/psi_sovrl_upd_a.f90 +++ b/base/comm/internals/psi_sovrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) return end subroutine psi_sovrl_updr1 - subroutine psi_sovrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_sovrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_sswapdata.F90 b/base/comm/internals/psi_sswapdata.F90 index b5185198..0f27d260 100644 --- a/base/comm/internals/psi_sswapdata.F90 +++ b/base/comm/internals/psi_sswapdata.F90 @@ -113,7 +113,9 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -190,8 +192,10 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_s_base_vect_type) :: y real(psb_spk_) :: beta real(psb_spk_), target :: work(:) @@ -199,7 +203,8 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -413,7 +418,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_sswap_vidx_vect @@ -450,7 +455,9 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -527,8 +534,10 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_s_base_multivect_type) :: y real(psb_spk_) :: beta real(psb_spk_), target :: work(:) @@ -536,7 +545,8 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -756,7 +766,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_sswap_vidx_multivect diff --git a/base/comm/internals/psi_sswapdata_a.F90 b/base/comm/internals/psi_sswapdata_a.F90 index 5b591bf3..ce9bbbe8 100644 --- a/base/comm/internals/psi_sswapdata_a.F90 +++ b/base/comm/internals/psi_sswapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_sswapdatam -subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_sswapidxm @@ -167,14 +169,17 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_sswapidxm @@ -579,7 +582,9 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:), beta real(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_sswapidxv diff --git a/base/comm/internals/psi_sswaptran.F90 b/base/comm/internals/psi_sswaptran.F90 index cb3ccc75..69f6b95d 100644 --- a/base/comm/internals/psi_sswaptran.F90 +++ b/base/comm/internals/psi_sswaptran.F90 @@ -115,7 +115,9 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -161,8 +163,6 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) return end subroutine psi_sswaptran_vect - - ! ! ! Subroutine: psi_stran_vidx_vect @@ -193,7 +193,9 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_s_base_vect_type) :: y real(psb_spk_) :: beta @@ -202,7 +204,8 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -422,7 +425,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -463,7 +466,9 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -540,7 +545,9 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_s_base_multivect_type) :: y real(psb_spk_) :: beta @@ -549,7 +556,8 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -773,7 +781,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/internals/psi_sswaptran_a.F90 b/base/comm/internals/psi_sswaptran_a.F90 index 890a7a58..18142908 100644 --- a/base/comm/internals/psi_sswaptran_a.F90 +++ b/base/comm/internals/psi_sswaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_stranidxm @@ -592,7 +597,9 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:), beta real(psb_spk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_stranidxv diff --git a/base/comm/internals/psi_zovrl_restr.f90 b/base/comm/internals/psi_zovrl_restr.f90 index e52232e7..b9cb1a8a 100644 --- a/base/comm/internals/psi_zovrl_restr.f90 +++ b/base/comm/internals/psi_zovrl_restr.f90 @@ -47,7 +47,8 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_zovrl_restr_vect' @@ -89,7 +90,8 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_zovrl_restr_mv' diff --git a/base/comm/internals/psi_zovrl_restr_a.f90 b/base/comm/internals/psi_zovrl_restr_a.f90 index 379efdcb..34409387 100644 --- a/base/comm/internals/psi_zovrl_restr_a.f90 +++ b/base/comm/internals/psi_zovrl_restr_a.f90 @@ -45,7 +45,8 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_zovrl_restrr1' @@ -88,7 +89,8 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_zovrl_restrr2' diff --git a/base/comm/internals/psi_zovrl_save.f90 b/base/comm/internals/psi_zovrl_save.f90 index acf65181..e8f88f5a 100644 --- a/base/comm/internals/psi_zovrl_save.f90 +++ b/base/comm/internals/psi_zovrl_save.f90 @@ -47,7 +47,8 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_dovrl_saver1' @@ -82,8 +83,6 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) return end subroutine psi_zovrl_save_vect - - subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) use psi_mod, psi_protect_name => psi_zovrl_save_multivect use psb_realloc_mod @@ -97,7 +96,8 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_dovrl_saver1' diff --git a/base/comm/internals/psi_zovrl_save_a.f90 b/base/comm/internals/psi_zovrl_save_a.f90 index 1e8fdb89..fbb108a9 100644 --- a/base/comm/internals/psi_zovrl_save_a.f90 +++ b/base/comm/internals/psi_zovrl_save_a.f90 @@ -47,7 +47,8 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err name='psi_zovrl_saver1' @@ -99,7 +100,8 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err name='psi_zovrl_saver2' diff --git a/base/comm/internals/psi_zovrl_upd.f90 b/base/comm/internals/psi_zovrl_upd.f90 index cd7ea0de..f18e914d 100644 --- a/base/comm/internals/psi_zovrl_upd.f90 +++ b/base/comm/internals/psi_zovrl_upd.f90 @@ -32,7 +32,7 @@ ! Subroutine: psi_zovrl_update ! These subroutines update the overlap region of a vector; they are used ! for the transpose matrix-vector product when there is a nonempty overlap, -! or for the application of Additive Schwarz preconditioners. +! or for the application of Additive Schwarz preconditioners. ! ! ! @@ -50,7 +50,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -131,7 +132,8 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:,:) - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx, nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_zovrl_upd_a.f90 b/base/comm/internals/psi_zovrl_upd_a.f90 index 9ea2fbae..ed775e4c 100644 --- a/base/comm/internals/psi_zovrl_upd_a.f90 +++ b/base/comm/internals/psi_zovrl_upd_a.f90 @@ -46,7 +46,8 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -103,7 +104,6 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) return end subroutine psi_zovrl_updr1 - subroutine psi_zovrl_updr2(x,desc_a,update,info) use psi_mod, psi_protect_name => psi_zovrl_updr2 @@ -115,7 +115,8 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err diff --git a/base/comm/internals/psi_zswapdata.F90 b/base/comm/internals/psi_zswapdata.F90 index 7d34012e..fbf17803 100644 --- a/base/comm/internals/psi_zswapdata.F90 +++ b/base/comm/internals/psi_zswapdata.F90 @@ -113,7 +113,9 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -190,8 +192,10 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_z_base_vect_type) :: y complex(psb_dpk_) :: beta complex(psb_dpk_), target :: work(:) @@ -199,7 +203,8 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -413,7 +418,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_zswap_vidx_vect @@ -450,7 +455,9 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -527,8 +534,10 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_z_base_multivect_type) :: y complex(psb_dpk_) :: beta complex(psb_dpk_), target :: work(:) @@ -536,7 +545,8 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -756,7 +766,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_zswap_vidx_multivect diff --git a/base/comm/internals/psi_zswapdata_a.F90 b/base/comm/internals/psi_zswapdata_a.F90 index 19026b97..ea2e69ab 100644 --- a/base/comm/internals/psi_zswapdata_a.F90 +++ b/base/comm/internals/psi_zswapdata_a.F90 @@ -106,7 +106,9 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -152,7 +154,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) return end subroutine psi_zswapdatam -subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & +subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_zswapidxm @@ -167,14 +169,17 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + + integer(psb_mpk_) :: np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -192,8 +197,6 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & info=psb_success_ name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = iictxt - icomm = iicomm call psb_info(ictxt,me,np) if (np == -1) then @@ -498,7 +501,7 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_zswapidxm @@ -579,7 +582,9 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -651,14 +656,17 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:), beta complex(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -980,7 +988,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_zswapidxv diff --git a/base/comm/internals/psi_zswaptran.F90 b/base/comm/internals/psi_zswaptran.F90 index c78a5e1a..ab1889f0 100644 --- a/base/comm/internals/psi_zswaptran.F90 +++ b/base/comm/internals/psi_zswaptran.F90 @@ -115,7 +115,9 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -161,8 +163,6 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) return end subroutine psi_zswaptran_vect - - ! ! ! Subroutine: psi_ztran_vidx_vect @@ -193,7 +193,9 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_z_base_vect_type) :: y complex(psb_dpk_) :: beta @@ -202,7 +204,8 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -422,7 +425,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -463,7 +466,9 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx character(len=20) :: name @@ -540,7 +545,9 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_z_base_multivect_type) :: y complex(psb_dpk_) :: beta @@ -549,7 +556,8 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) integer(psb_ipk_) :: nesd, nerv,& @@ -773,7 +781,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/internals/psi_zswaptran_a.F90 b/base/comm/internals/psi_zswaptran_a.F90 index 46e4a898..8625ea71 100644 --- a/base/comm/internals/psi_zswaptran_a.F90 +++ b/base/comm/internals/psi_zswaptran_a.F90 @@ -110,7 +110,9 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, err_act, totxch, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -172,14 +174,17 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag,n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag,n + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -508,7 +513,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_ztranidxm @@ -592,7 +597,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) character(len=20) :: name @@ -664,14 +671,17 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:), beta complex(psb_dpk_), target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - integer(psb_mpk_) :: ictxt, icomm, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd @@ -996,7 +1006,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(iictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psi_ztranidxv diff --git a/base/comm/psb_cgather.f90 b/base/comm/psb_cgather.f90 index f4ed3f4a..0980d128 100644 --- a/base/comm/psb_cgather.f90 +++ b/base/comm/psb_cgather.f90 @@ -57,7 +57,8 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx complex(psb_spk_), allocatable :: llocx(:) @@ -153,7 +154,7 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -174,7 +175,8 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx complex(psb_spk_), allocatable :: llocx(:,:) @@ -269,7 +271,7 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_cgather_a.f90 b/base/comm/psb_cgather_a.f90 index 5f75abd6..ed32bf8c 100644 --- a/base/comm/psb_cgather_a.f90 +++ b/base/comm/psb_cgather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_cgatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_chalo.f90 b/base/comm/psb_chalo.f90 index ad483a51..675c42ef 100644 --- a/base/comm/psb_chalo.f90 +++ b/base/comm/psb_chalo.f90 @@ -65,7 +65,8 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:) @@ -179,7 +180,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_chalo_vect @@ -219,7 +220,8 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:) @@ -334,7 +336,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_chalo_multivect diff --git a/base/comm/psb_chalo_a.f90 b/base/comm/psb_chalo_a.f90 index 5f18ebb6..010e152a 100644 --- a/base/comm/psb_chalo_a.f90 +++ b/base/comm/psb_chalo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_chalom @@ -266,7 +267,8 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_chalov diff --git a/base/comm/psb_covrl.f90 b/base/comm/psb_covrl.f90 index 7ac851b6..ba8de110 100644 --- a/base/comm/psb_covrl.f90 +++ b/base/comm/psb_covrl.f90 @@ -75,7 +75,8 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:) @@ -175,7 +176,7 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_covrl_vect @@ -224,7 +225,8 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:) @@ -326,7 +328,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_covrl_multivect diff --git a/base/comm/psb_covrl_a.f90 b/base/comm/psb_covrl_a.f90 index 8949b7ed..b661c01e 100644 --- a/base/comm/psb_covrl_a.f90 +++ b/base/comm/psb_covrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_covrlm @@ -265,7 +266,8 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx complex(psb_spk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_covrlv diff --git a/base/comm/psb_cscatter.F90 b/base/comm/psb_cscatter.F90 index 7ac22a68..288becd1 100644 --- a/base/comm/psb_cscatter.F90 +++ b/base/comm/psb_cscatter.F90 @@ -54,7 +54,8 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_c_base_vect_type), intent(in), optional :: mold ! locals - integer(psb_mpk_) :: ictxt, np, me, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx complex(psb_spk_), allocatable :: vlocx(:) @@ -92,7 +93,7 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_cscatter_a.F90 b/base/comm/psb_cscatter_a.F90 index d16ae980..11f6ad5e 100644 --- a/base/comm/psb_cscatter_a.F90 +++ b/base/comm/psb_cscatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 72bfa774..e46706d8 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -67,7 +67,8 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) @@ -216,7 +217,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -249,7 +250,8 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -388,7 +390,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -420,7 +422,8 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -554,7 +557,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_dgather.f90 b/base/comm/psb_dgather.f90 index c767c8ec..d1dc27c1 100644 --- a/base/comm/psb_dgather.f90 +++ b/base/comm/psb_dgather.f90 @@ -57,7 +57,8 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx real(psb_dpk_), allocatable :: llocx(:) @@ -153,7 +154,7 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -174,7 +175,8 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx real(psb_dpk_), allocatable :: llocx(:,:) @@ -269,7 +271,7 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_dgather_a.f90 b/base/comm/psb_dgather_a.f90 index 5ae9ed50..5ff78165 100644 --- a/base/comm/psb_dgather_a.f90 +++ b/base/comm/psb_dgather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_dgatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_dhalo.f90 b/base/comm/psb_dhalo.f90 index b5f584dc..65d92dd5 100644 --- a/base/comm/psb_dhalo.f90 +++ b/base/comm/psb_dhalo.f90 @@ -65,7 +65,8 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:) @@ -179,7 +180,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dhalo_vect @@ -219,7 +220,8 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:) @@ -334,7 +336,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dhalo_multivect diff --git a/base/comm/psb_dhalo_a.f90 b/base/comm/psb_dhalo_a.f90 index bee4cd18..d1963f09 100644 --- a/base/comm/psb_dhalo_a.f90 +++ b/base/comm/psb_dhalo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dhalom @@ -266,7 +267,8 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dhalov diff --git a/base/comm/psb_dovrl.f90 b/base/comm/psb_dovrl.f90 index 1177be29..2a6dbefe 100644 --- a/base/comm/psb_dovrl.f90 +++ b/base/comm/psb_dovrl.f90 @@ -75,7 +75,8 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:) @@ -175,7 +176,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dovrl_vect @@ -224,7 +225,8 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:) @@ -326,7 +328,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dovrl_multivect diff --git a/base/comm/psb_dovrl_a.f90 b/base/comm/psb_dovrl_a.f90 index 5ef1738d..7d2821a9 100644 --- a/base/comm/psb_dovrl_a.f90 +++ b/base/comm/psb_dovrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dovrlm @@ -265,7 +266,8 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx real(psb_dpk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_dovrlv diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 157af3c6..5ca8ebaa 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -54,7 +54,8 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_d_base_vect_type), intent(in), optional :: mold ! locals - integer(psb_mpk_) :: ictxt, np, me, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx real(psb_dpk_), allocatable :: vlocx(:) @@ -92,7 +93,7 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_dscatter_a.F90 b/base/comm/psb_dscatter_a.F90 index e0b39f57..6f09e5e3 100644 --- a/base/comm/psb_dscatter_a.F90 +++ b/base/comm/psb_dscatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index a29ac002..bacf07ab 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -67,7 +67,8 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) @@ -216,7 +217,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -249,7 +250,8 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -388,7 +390,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -420,7 +422,8 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -554,7 +557,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_egather_a.f90 b/base/comm/psb_egather_a.f90 index b910a4f7..4e3e3fe5 100644 --- a/base/comm/psb_egather_a.f90 +++ b/base/comm/psb_egather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_egatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_ehalo_a.f90 b/base/comm/psb_ehalo_a.f90 index 42a47a16..b52a2316 100644 --- a/base/comm/psb_ehalo_a.f90 +++ b/base/comm/psb_ehalo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_ehalom @@ -266,7 +267,8 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_epk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_ehalov diff --git a/base/comm/psb_eovrl_a.f90 b/base/comm/psb_eovrl_a.f90 index 4b9372d4..45cac36c 100644 --- a/base/comm/psb_eovrl_a.f90 +++ b/base/comm/psb_eovrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_eovrlm @@ -265,7 +266,8 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_epk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_eovrlv diff --git a/base/comm/psb_escatter_a.F90 b/base/comm/psb_escatter_a.F90 index dbb2026f..d07f63ad 100644 --- a/base/comm/psb_escatter_a.F90 +++ b/base/comm/psb_escatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_i2gather_a.f90 b/base/comm/psb_i2gather_a.f90 index 9a671ef6..38053808 100644 --- a/base/comm/psb_i2gather_a.f90 +++ b/base/comm/psb_i2gather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_i2gatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_i2halo_a.f90 b/base/comm/psb_i2halo_a.f90 index f9c17fa5..6e0fefe0 100644 --- a/base/comm/psb_i2halo_a.f90 +++ b/base/comm/psb_i2halo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_i2halom @@ -266,7 +267,8 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_i2pk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_i2halov diff --git a/base/comm/psb_i2ovrl_a.f90 b/base/comm/psb_i2ovrl_a.f90 index 8d056e39..1cd189c8 100644 --- a/base/comm/psb_i2ovrl_a.f90 +++ b/base/comm/psb_i2ovrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_i2ovrlm @@ -265,7 +266,8 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_i2pk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_i2ovrlv diff --git a/base/comm/psb_i2scatter_a.F90 b/base/comm/psb_i2scatter_a.F90 index 4a72458e..3a6ba142 100644 --- a/base/comm/psb_i2scatter_a.F90 +++ b/base/comm/psb_i2scatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_igather.f90 b/base/comm/psb_igather.f90 index 48a4f2fe..ec815de4 100644 --- a/base/comm/psb_igather.f90 +++ b/base/comm/psb_igather.f90 @@ -57,7 +57,8 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_ipk_), allocatable :: llocx(:) @@ -153,7 +154,7 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -174,7 +175,8 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_ipk_), allocatable :: llocx(:,:) @@ -269,7 +271,7 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_ihalo.f90 b/base/comm/psb_ihalo.f90 index 4bccfc10..61132bc5 100644 --- a/base/comm/psb_ihalo.f90 +++ b/base/comm/psb_ihalo.f90 @@ -65,7 +65,8 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_ipk_),pointer :: iwork(:) @@ -179,7 +180,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_ihalo_vect @@ -219,7 +220,8 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_ipk_),pointer :: iwork(:) @@ -334,7 +336,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_ihalo_multivect diff --git a/base/comm/psb_iovrl.f90 b/base/comm/psb_iovrl.f90 index 06f720b0..7ca6068e 100644 --- a/base/comm/psb_iovrl.f90 +++ b/base/comm/psb_iovrl.f90 @@ -75,7 +75,8 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_ipk_),pointer :: iwork(:) @@ -175,7 +176,7 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_iovrl_vect @@ -224,7 +225,8 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_ipk_),pointer :: iwork(:) @@ -326,7 +328,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_iovrl_multivect diff --git a/base/comm/psb_iscatter.F90 b/base/comm/psb_iscatter.F90 index f159d5b4..94dec0b0 100644 --- a/base/comm/psb_iscatter.F90 +++ b/base/comm/psb_iscatter.F90 @@ -54,7 +54,8 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_i_base_vect_type), intent(in), optional :: mold ! locals - integer(psb_mpk_) :: ictxt, np, me, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_ipk_), allocatable :: vlocx(:) @@ -92,7 +93,7 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_ispgather.F90 b/base/comm/psb_ispgather.F90 index ed723289..51d4a0de 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -67,7 +67,8 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) @@ -216,7 +217,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -249,7 +250,8 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -388,7 +390,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -420,7 +422,8 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -554,7 +557,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_lgather.f90 b/base/comm/psb_lgather.f90 index 1f6f448f..4f7555b0 100644 --- a/base/comm/psb_lgather.f90 +++ b/base/comm/psb_lgather.f90 @@ -57,7 +57,8 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_), allocatable :: llocx(:) @@ -153,7 +154,7 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -174,7 +175,8 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx integer(psb_lpk_), allocatable :: llocx(:,:) @@ -269,7 +271,7 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_lhalo.f90 b/base/comm/psb_lhalo.f90 index b35613a1..ae2235e7 100644 --- a/base/comm/psb_lhalo.f90 +++ b/base/comm/psb_lhalo.f90 @@ -65,7 +65,8 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_),pointer :: iwork(:) @@ -179,7 +180,7 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_lhalo_vect @@ -219,7 +220,8 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_),pointer :: iwork(:) @@ -334,7 +336,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_lhalo_multivect diff --git a/base/comm/psb_lovrl.f90 b/base/comm/psb_lovrl.f90 index bb3ece65..38572d33 100644 --- a/base/comm/psb_lovrl.f90 +++ b/base/comm/psb_lovrl.f90 @@ -75,7 +75,8 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_),pointer :: iwork(:) @@ -175,7 +176,7 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_lovrl_vect @@ -224,7 +225,8 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_lpk_),pointer :: iwork(:) @@ -326,7 +328,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_lovrl_multivect diff --git a/base/comm/psb_lscatter.F90 b/base/comm/psb_lscatter.F90 index ceb60e4f..d161967a 100644 --- a/base/comm/psb_lscatter.F90 +++ b/base/comm/psb_lscatter.F90 @@ -54,7 +54,8 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_l_base_vect_type), intent(in), optional :: mold ! locals - integer(psb_mpk_) :: ictxt, np, me, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_), allocatable :: vlocx(:) @@ -92,7 +93,7 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_lspgather.F90 b/base/comm/psb_lspgather.F90 index 5d2d33e9..6d5e6182 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -67,7 +67,8 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) @@ -216,7 +217,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -249,7 +250,8 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -388,7 +390,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -420,7 +422,8 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -554,7 +557,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_mgather_a.f90 b/base/comm/psb_mgather_a.f90 index 251e06c9..af3136ca 100644 --- a/base/comm/psb_mgather_a.f90 +++ b/base/comm/psb_mgather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_mgatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_mgatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_mgatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_mhalo_a.f90 b/base/comm/psb_mhalo_a.f90 index f6745cd4..8b9502df 100644 --- a/base/comm/psb_mhalo_a.f90 +++ b/base/comm/psb_mhalo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_mhalom @@ -266,7 +267,8 @@ subroutine psb_mhalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx integer(psb_mpk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_mhalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_mhalov diff --git a/base/comm/psb_movrl_a.f90 b/base/comm/psb_movrl_a.f90 index 9d8beae9..39d4d6bd 100644 --- a/base/comm/psb_movrl_a.f90 +++ b/base/comm/psb_movrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_movrlm @@ -265,7 +266,8 @@ subroutine psb_movrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx integer(psb_mpk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_movrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_movrlv diff --git a/base/comm/psb_mscatter_a.F90 b/base/comm/psb_mscatter_a.F90 index f85a3849..b907a015 100644 --- a/base/comm/psb_mscatter_a.F90 +++ b/base/comm/psb_mscatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_sgather.f90 b/base/comm/psb_sgather.f90 index 538d1c43..d1c43f29 100644 --- a/base/comm/psb_sgather.f90 +++ b/base/comm/psb_sgather.f90 @@ -57,7 +57,8 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx real(psb_spk_), allocatable :: llocx(:) @@ -153,7 +154,7 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -174,7 +175,8 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx real(psb_spk_), allocatable :: llocx(:,:) @@ -269,7 +271,7 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_sgather_a.f90 b/base/comm/psb_sgather_a.f90 index 47a8c79a..7774a11c 100644 --- a/base/comm/psb_sgather_a.f90 +++ b/base/comm/psb_sgather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_sgatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_shalo.f90 b/base/comm/psb_shalo.f90 index 78ab39e3..18548183 100644 --- a/base/comm/psb_shalo.f90 +++ b/base/comm/psb_shalo.f90 @@ -65,7 +65,8 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:) @@ -179,7 +180,7 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_shalo_vect @@ -219,7 +220,8 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:) @@ -334,7 +336,7 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_shalo_multivect diff --git a/base/comm/psb_shalo_a.f90 b/base/comm/psb_shalo_a.f90 index 9d1a5717..63d88874 100644 --- a/base/comm/psb_shalo_a.f90 +++ b/base/comm/psb_shalo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_shalom @@ -266,7 +267,8 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_shalov diff --git a/base/comm/psb_sovrl.f90 b/base/comm/psb_sovrl.f90 index 3930645a..c61161c0 100644 --- a/base/comm/psb_sovrl.f90 +++ b/base/comm/psb_sovrl.f90 @@ -75,7 +75,8 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:) @@ -175,7 +176,7 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_sovrl_vect @@ -224,7 +225,8 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:) @@ -326,7 +328,7 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_sovrl_multivect diff --git a/base/comm/psb_sovrl_a.f90 b/base/comm/psb_sovrl_a.f90 index b2f19fdd..23380de5 100644 --- a/base/comm/psb_sovrl_a.f90 +++ b/base/comm/psb_sovrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_sovrlm @@ -265,7 +266,8 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx real(psb_spk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_sovrlv diff --git a/base/comm/psb_sscatter.F90 b/base/comm/psb_sscatter.F90 index 960c5bac..56761278 100644 --- a/base/comm/psb_sscatter.F90 +++ b/base/comm/psb_sscatter.F90 @@ -54,7 +54,8 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_s_base_vect_type), intent(in), optional :: mold ! locals - integer(psb_mpk_) :: ictxt, np, me, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx real(psb_spk_), allocatable :: vlocx(:) @@ -92,7 +93,7 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_sscatter_a.F90 b/base/comm/psb_sscatter_a.F90 index d756b712..783d3576 100644 --- a/base/comm/psb_sscatter_a.F90 +++ b/base/comm/psb_sscatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index 83db9c08..9d0cc681 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -67,7 +67,8 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) @@ -216,7 +217,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -249,7 +250,8 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -388,7 +390,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -420,7 +422,8 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -554,7 +557,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_zgather.f90 b/base/comm/psb_zgather.f90 index b8b9a6c8..d7617334 100644 --- a/base/comm/psb_zgather.f90 +++ b/base/comm/psb_zgather.f90 @@ -57,7 +57,8 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx complex(psb_dpk_), allocatable :: llocx(:) @@ -153,7 +154,7 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -174,7 +175,8 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx complex(psb_dpk_), allocatable :: llocx(:,:) @@ -269,7 +271,7 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_zgather_a.f90 b/base/comm/psb_zgather_a.f90 index 1c3838cb..ed5b3553 100644 --- a/base/comm/psb_zgather_a.f90 +++ b/base/comm/psb_zgather_a.f90 @@ -57,12 +57,12 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx - - character(len=20) :: name, ch_err + character(len=20) :: name, ch_err name='psb_zgatherm' info=psb_success_ @@ -162,7 +162,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -231,7 +231,8 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) ! locals - integer(psb_mpk_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j integer(psb_lpk_) :: m, n, ilocx, jlocx, idx, iglobx, jglobx @@ -327,7 +328,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_zhalo.f90 b/base/comm/psb_zhalo.f90 index 595cbc03..64cd9b2d 100644 --- a/base/comm/psb_zhalo.f90 +++ b/base/comm/psb_zhalo.f90 @@ -65,7 +65,8 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:) @@ -179,7 +180,7 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zhalo_vect @@ -219,7 +220,8 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:) @@ -334,7 +336,7 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zhalo_multivect diff --git a/base/comm/psb_zhalo_a.f90 b/base/comm/psb_zhalo_a.f90 index c9a6b8a7..ede690d3 100644 --- a/base/comm/psb_zhalo_a.f90 +++ b/base/comm/psb_zhalo_a.f90 @@ -65,7 +65,8 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -192,7 +193,7 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zhalom @@ -266,7 +267,8 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:) @@ -373,7 +375,7 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zhalov diff --git a/base/comm/psb_zovrl.f90 b/base/comm/psb_zovrl.f90 index c7463e19..13aed091 100644 --- a/base/comm/psb_zovrl.f90 +++ b/base/comm/psb_zovrl.f90 @@ -75,7 +75,8 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:) @@ -175,7 +176,7 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zovrl_vect @@ -224,7 +225,8 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, k, iix, jjx, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:) @@ -326,7 +328,7 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zovrl_multivect diff --git a/base/comm/psb_zovrl_a.f90 b/base/comm/psb_zovrl_a.f90 index 49a60740..362f98ab 100644 --- a/base/comm/psb_zovrl_a.f90 +++ b/base/comm/psb_zovrl_a.f90 @@ -76,7 +76,8 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -187,7 +188,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zovrlm @@ -265,7 +266,8 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - integer(psb_ipk_) :: ictxt, np, me, err_act, iix, jjx, nrow, ncol, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx complex(psb_dpk_),pointer :: iwork(:) @@ -368,7 +370,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return end subroutine psb_zovrlv diff --git a/base/comm/psb_zscatter.F90 b/base/comm/psb_zscatter.F90 index 10c2c78d..753a468b 100644 --- a/base/comm/psb_zscatter.F90 +++ b/base/comm/psb_zscatter.F90 @@ -54,7 +54,8 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_z_base_vect_type), intent(in), optional :: mold ! locals - integer(psb_mpk_) :: ictxt, np, me, icomm, myrank, rootrank + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx complex(psb_dpk_), allocatable :: vlocx(:) @@ -92,7 +93,7 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_zscatter_a.F90 b/base/comm/psb_zscatter_a.F90 index b206d8d3..59a98f9b 100644 --- a/base/comm/psb_zscatter_a.F90 +++ b/base/comm/psb_zscatter_a.F90 @@ -62,7 +62,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos @@ -235,7 +236,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return @@ -306,7 +307,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) ! locals - integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx @@ -472,7 +474,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 98b7d215..87745fa4 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -67,7 +67,8 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: locia(:), locja(:), glbia(:), glbja(:) @@ -216,7 +217,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -249,7 +250,8 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -388,7 +390,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return @@ -420,7 +422,8 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - integer(psb_mpk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) integer(psb_lpk_), allocatable :: lnzbr(:) @@ -554,7 +557,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ione*ictxt,err_act) + call psb_error_handler(ictxt,err_act) return diff --git a/base/internals/Makefile b/base/internals/Makefile index cbb282a9..b3a1a995 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -1,12 +1,12 @@ include ../../Make.inc -FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ +FOBJS = psi_crea_bnd_elem.o psi_crea_index.o \ psi_crea_ovr_elem.o psi_bld_tmpovrl.o \ psi_bld_tmphalo.o psi_sort_dl.o \ psi_indx_map_fnd_owner.o \ psi_desc_impl.o psi_hash_impl.o psi_srtlist.o \ psi_bld_glb_dep_list.o psi_xtr_loc_dl.o -#psi_list_search.o psi_dl_check.o +#psi_list_search.o psi_dl_check.o psi_compute_size.o MPFOBJS = psi_desc_index.o psi_extrct_dl.o psi_fnd_owner.o psi_a2a_fnd_owner.o \ psi_graph_fnd_owner.o psi_adjcncy_fnd_owner.o psi_symm_dep_list.o diff --git a/base/internals/psi_a2a_fnd_owner.F90 b/base/internals/psi_a2a_fnd_owner.F90 index b9cd9bb2..b0912078 100644 --- a/base/internals/psi_a2a_fnd_owner.F90 +++ b/base/internals/psi_a2a_fnd_owner.F90 @@ -74,14 +74,15 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) integer(psb_ipk_), allocatable :: tproc(:), lclidx(:) integer(psb_mpk_), allocatable :: hsz(:),hidx(:), sdidx(:), rvidx(:),& & sdsz(:), rvsz(:), sdhd(:), rvhd(:), p2pstat(:,:) - integer(psb_mpk_) :: icomm, minfo, iictxt,nv + integer(psb_mpk_) :: icomm, minfo, nv integer(psb_ipk_) :: i,n_row,n_col,err_act,gsz integer(psb_lpk_) :: mglob, ih - integer(psb_ipk_) :: ictxt,np,me, nresp - logical, parameter :: use_psi_adj=.true. - real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx - character(len=20) :: name - logical :: samesize_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, nresp + logical, parameter :: use_psi_adj=.true. + real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx + character(len=20) :: name + logical :: samesize_ info = psb_success_ name = 'psi_a2a_fnd_owner' @@ -92,7 +93,6 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) mglob = idxmap%get_gr() n_row = idxmap%get_lr() n_col = idxmap%get_lc() - iictxt = ictxt call psb_info(ictxt, me, np) diff --git a/base/internals/psi_adjcncy_fnd_owner.F90 b/base/internals/psi_adjcncy_fnd_owner.F90 index f26bb38f..40ee26dc 100644 --- a/base/internals/psi_adjcncy_fnd_owner.F90 +++ b/base/internals/psi_adjcncy_fnd_owner.F90 @@ -81,11 +81,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) integer(psb_mpk_), allocatable :: hsz(:),hidx(:), sdidx(:), rvidx(:),& & sdsz(:), rvsz(:), sdhd(:), rvhd(:), p2pstat(:,:) integer(psb_mpk_) :: prc, p2ptag, iret - integer(psb_mpk_) :: icomm, minfo, iictxt + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_) :: i,n_row,n_col,err_act,hsize,ip,isz,j, k,& & last_ih, last_j, nidx, nrecv, nadj integer(psb_lpk_) :: mglob, ih - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: gettime=.true., debug=.false. integer(psb_mpk_) :: xchg_alg logical, parameter :: do_timings=.false. @@ -103,7 +104,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) mglob = idxmap%get_gr() n_row = idxmap%get_lr() n_col = idxmap%get_lc() - iictxt = ictxt + if ((do_timings).and.(idx_phase1==-1)) & & idx_phase1 = psb_get_timer_idx("ADJ_FND_OWN: phase1 ") if ((do_timings).and.(idx_phase2==-1)) & diff --git a/base/internals/psi_bld_glb_dep_list.F90 b/base/internals/psi_bld_glb_dep_list.F90 index bf28e49b..94a31039 100644 --- a/base/internals/psi_bld_glb_dep_list.F90 +++ b/base/internals/psi_bld_glb_dep_list.F90 @@ -29,94 +29,94 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psi_i_bld_glb_dep_list(ictxt,loc_dl,length_dl,dep_list,dl_lda,info) - use psi_mod, psb_protect_name => psi_i_bld_glb_dep_list -#ifdef MPI_MOD - use mpi -#endif - use psb_penv_mod - use psb_const_mod - use psb_error_mod - use psb_desc_mod - use psb_sort_mod - implicit none -#ifdef MPI_H - include 'mpif.h' -#endif - ! ....scalar parameters... - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dl_lda - integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) - integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) - integer(psb_ipk_), intent(out) :: info - - - ! .....local arrays.... - integer(psb_ipk_) :: int_err(5) - - ! .....local scalars... - integer(psb_ipk_) :: i, proc,j,err_act - integer(psb_ipk_) :: err - integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt, icomm, me, np, minfo - logical, parameter :: dist_symm_list=.false., print_dl=.false. - character name*20 - name='psi_bld_glb_dep_list' - - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - - iictxt = ictxt - info = psb_success_ - - call psb_info(iictxt,me,np) - - - dl_lda = length_dl(me) - call psb_max(iictxt, dl_lda) - - if (debug_level >= psb_debug_inner_) & - & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda - dl_lda = max(dl_lda,1) - allocate(dep_list(dl_lda,0:np),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 - end if - icomm = psb_get_mpi_comm(iictxt) - call mpi_allgather(loc_dl,dl_lda,psb_mpi_ipk_,& - & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) - - info = minfo - if (info /= psb_success_) then - info=psb_err_internal_error_ - goto 9999 - endif - if (print_dl) then - if (me == 0) then - write(0,*) ' Dep_list ' - do i=0,np-1 - j = length_dl(i) - write(0,*) 'Proc ',i,':',dep_list(1:j,i) - end do - flush(0) - end if - call psb_barrier(ictxt) - end if - - call psb_erractionrestore(err_act) - return - - -9999 continue - - call psb_errpush(info,name,i_err=int_err) - call psb_error_handler(err_act) - - return - -end subroutine psi_i_bld_glb_dep_list +!!$subroutine psi_i_bld_glb_dep_list(ictxt,loc_dl,length_dl,dep_list,dl_lda,info) +!!$ use psi_mod, psb_protect_name => psi_i_bld_glb_dep_list +!!$#ifdef MPI_MOD +!!$ use mpi +!!$#endif +!!$ use psb_penv_mod +!!$ use psb_const_mod +!!$ use psb_error_mod +!!$ use psb_desc_mod +!!$ use psb_sort_mod +!!$ implicit none +!!$#ifdef MPI_H +!!$ include 'mpif.h' +!!$#endif +!!$ ! ....scalar parameters... +!!$ type(psb_ctxt_type), intent(in) :: ictxt +!!$ integer(psb_ipk_), intent(out) :: dl_lda +!!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) +!!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ +!!$ +!!$ ! .....local arrays.... +!!$ integer(psb_ipk_) :: int_err(5) +!!$ +!!$ ! .....local scalars... +!!$ integer(psb_ipk_) :: i, proc,j,err_act +!!$ integer(psb_ipk_) :: err +!!$ integer(psb_ipk_) :: debug_level, debug_unit +!!$ integer(psb_ipk_) :: me, np +!!$ integer(psb_mpk_) :: icomm, minfo +!!$ logical, parameter :: dist_symm_list=.false., print_dl=.false. +!!$ character name*20 +!!$ name='psi_bld_glb_dep_list' +!!$ +!!$ call psb_erractionsave(err_act) +!!$ debug_unit = psb_get_debug_unit() +!!$ debug_level = psb_get_debug_level() +!!$ +!!$ info = psb_success_ +!!$ +!!$ call psb_info(ictxt,me,np) +!!$ +!!$ +!!$ dl_lda = length_dl(me) +!!$ call psb_max(ictxt, dl_lda) +!!$ +!!$ if (debug_level >= psb_debug_inner_) & +!!$ & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda +!!$ dl_lda = max(dl_lda,1) +!!$ allocate(dep_list(dl_lda,0:np),stat=info) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') +!!$ goto 9999 +!!$ end if +!!$ icomm = psb_get_mpi_comm(ictxt) +!!$ call mpi_allgather(loc_dl,dl_lda,psb_mpi_ipk_,& +!!$ & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) +!!$ +!!$ info = minfo +!!$ if (info /= psb_success_) then +!!$ info=psb_err_internal_error_ +!!$ goto 9999 +!!$ endif +!!$ if (print_dl) then +!!$ if (me == 0) then +!!$ write(0,*) ' Dep_list ' +!!$ do i=0,np-1 +!!$ j = length_dl(i) +!!$ write(0,*) 'Proc ',i,':',dep_list(1:j,i) +!!$ end do +!!$ flush(0) +!!$ end if +!!$ call psb_barrier(ictxt) +!!$ end if +!!$ +!!$ call psb_erractionrestore(err_act) +!!$ return +!!$ +!!$ +!!$9999 continue +!!$ +!!$ call psb_errpush(info,name,i_err=int_err) +!!$ call psb_error_handler(err_act) +!!$ +!!$ return +!!$ +!!$end subroutine psi_i_bld_glb_dep_list subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) use psi_mod, psb_protect_name => psi_i_bld_glb_csr_dep_list @@ -133,7 +133,7 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i include 'mpif.h' #endif ! ....scalar parameters... - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) integer(psb_ipk_), intent(out) :: info @@ -146,7 +146,8 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i integer(psb_ipk_) :: i, proc,j,err_act, length, myld integer(psb_ipk_) :: err integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt, icomm, me, np, minfo + integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: icomm, minfo logical, parameter :: dist_symm_list=.false., print_dl=.false. character name*20 name='psi_bld_glb_csr_dep_list' @@ -155,10 +156,9 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - iictxt = ictxt info = psb_success_ - call psb_info(iictxt,me,np) + call psb_info(ictxt,me,np) myld = length_dl(me) length = sum(length_dl(0:np-1)) @@ -180,7 +180,7 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') goto 9999 end if - icomm = psb_get_mpi_comm(iictxt) + icomm = psb_get_mpi_comm(ictxt) call mpi_allgatherv(loc_dl,myld,psb_mpi_ipk_,& & c_dep_list,length_dl,dl_ptr,psb_mpi_ipk_,icomm,minfo) diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index dc13b7c2..4547d2cb 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -62,7 +62,8 @@ subroutine psi_bld_tmphalo(desc,info) integer(psb_ipk_) :: i,j,np,me,lhalo,nhalo,& & n_col, err_act, key, ih, nh, idx, nk,icomm - integer(psb_ipk_) :: ictxt,n_row + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: n_row character(len=20) :: name,ch_err info = psb_success_ diff --git a/base/internals/psi_bld_tmpovrl.f90 b/base/internals/psi_bld_tmpovrl.f90 index 671a20d3..68c137d2 100644 --- a/base/internals/psi_bld_tmpovrl.f90 +++ b/base/internals/psi_bld_tmpovrl.f90 @@ -68,8 +68,8 @@ subroutine psi_i_bld_tmpovrl(iv,desc,info) & l_ov_ix,l_ov_el, err_act, itmpov, k, glx, icomm integer(psb_ipk_) :: idx integer(psb_ipk_), allocatable :: ov_idx(:),ov_el(:,:) - - integer(psb_ipk_) :: ictxt,n_row, debug_unit, debug_level + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: n_row, debug_unit, debug_level character(len=20) :: name,ch_err info = psb_success_ diff --git a/base/internals/psi_compute_size.f90 b/base/internals/psi_compute_size.f90 index 36d52f43..699ceeac 100644 --- a/base/internals/psi_compute_size.f90 +++ b/base/internals/psi_compute_size.f90 @@ -47,7 +47,8 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info) integer(psb_ipk_) :: desc_data(:), index_in(:) ! ....local scalars.... integer(psb_ipk_) :: i,np,me,proc, max_index - integer(psb_ipk_) :: ictxt, err_act + integer(psb_ipk_) :: err_act + type(psb_ctxt_type) :: ictxt ! ...local array... integer(psb_ipk_) :: int_err(5) integer(psb_ipk_), allocatable :: counter_recv(:), counter_dl(:) diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 68bcbd20..8e8118f9 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -64,9 +64,11 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) integer(psb_ipk_), allocatable, intent(inout) :: index_out(:) ! ....local scalars... - integer(psb_ipk_) :: ictxt, me, np, mode, err_act, dl_lda, ldl + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, mode, err_act, dl_lda, ldl ! ...parameters... - integer(psb_ipk_), allocatable :: dep_list(:,:), length_dl(:), loc_dl(:), c_dep_list(:), dl_ptr(:) + integer(psb_ipk_), allocatable :: length_dl(:), loc_dl(:),& + & c_dep_list(:), dl_ptr(:) integer(psb_ipk_) :: dlmax, dlavg integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1 integer(psb_ipk_) :: debug_level, debug_unit @@ -124,7 +126,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (choose_sorting(dlmax,dlavg,np)) then if (do_timings) call psb_tic(idx_phase21) - call psi_bld_glb_dep_list(ictxt,& + call psi_bld_glb_dep_csr_list(ictxt,& & loc_dl,length_dl,c_dep_list,dl_ptr,info) if (info /= 0) then write(0,*) me,trim(name),' From bld_glb_list ',info @@ -189,8 +191,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) end if if (do_timings) call psb_toc(idx_phase3) - if (allocated(dep_list)) deallocate(dep_list,stat=info) - if ((info==0).and.allocated(length_dl)) deallocate(length_dl,stat=info) + if (allocated(length_dl)) deallocate(length_dl,stat=info) if (info /= 0) then info = psb_err_alloc_dealloc_ goto 9999 diff --git a/base/internals/psi_crea_ovr_elem.f90 b/base/internals/psi_crea_ovr_elem.f90 index 359c264c..bf9eeee4 100644 --- a/base/internals/psi_crea_ovr_elem.f90 +++ b/base/internals/psi_crea_ovr_elem.f90 @@ -63,7 +63,6 @@ subroutine psi_i_crea_ovr_elem(me,desc_overlap,ovr_elem,info) integer(psb_ipk_) :: nel, ip, ix, iel, insize, err_act, iproc integer(psb_ipk_), allocatable :: telem(:,:) - character(len=20) :: name diff --git a/base/internals/psi_desc_impl.f90 b/base/internals/psi_desc_impl.f90 index 43eae7bb..ce5d043e 100644 --- a/base/internals/psi_desc_impl.f90 +++ b/base/internals/psi_desc_impl.f90 @@ -74,8 +74,9 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) class(psb_i_base_vect_type), optional, intent(in) :: mold ! ....local scalars.... - integer(psb_ipk_) :: np,me - integer(psb_ipk_) :: ictxt, err_act,nxch,nsnd,nrcv,j,k + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me + integer(psb_ipk_) :: err_act,nxch,nsnd,nrcv,j,k ! ...local array... integer(psb_ipk_), allocatable :: idx_out(:), tmp_mst_idx(:) diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index ecf7f2f3..d2ed083b 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -121,7 +121,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& ! ....local scalars... integer(psb_ipk_) :: j,me,np,i,proc ! ...parameters... - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_), parameter :: no_comm=-1 ! ...local arrays.. integer(psb_lpk_),allocatable :: sndbuf(:), rcvbuf(:) diff --git a/base/internals/psi_extrct_dl.F90 b/base/internals/psi_extrct_dl.F90 index 1b5280f8..379bd99b 100644 --- a/base/internals/psi_extrct_dl.F90 +++ b/base/internals/psi_extrct_dl.F90 @@ -133,10 +133,11 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& include 'mpif.h' #endif ! ....scalar parameters... - logical, intent(in) :: is_bld, is_upd - integer(psb_ipk_), intent(in) :: ictxt,mode - integer(psb_ipk_), intent(out) :: dl_lda - integer(psb_ipk_), intent(in) :: desc_str(*) + logical, intent(in) :: is_bld, is_upd + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: mode + integer(psb_ipk_), intent(out) :: dl_lda + integer(psb_ipk_), intent(in) :: desc_str(*) integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:),length_dl(:) integer(psb_ipk_), intent(out) :: info ! .....local arrays.... @@ -147,7 +148,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& integer(psb_ipk_) :: i,pointer_dep_list,proc,j,err_act integer(psb_ipk_) :: err integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt, icomm, me, np, minfo + integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: icomm, minfo logical, parameter :: dist_symm_list=.false., print_dl=.false., profile=.true. logical, parameter :: do_timings=.false. integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 @@ -157,7 +159,6 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - iictxt = ictxt info = psb_success_ if ((do_timings).and.(idx_phase1==-1)) & & idx_phase1 = psb_get_timer_idx("PSI_XTR_DL: phase1 ") @@ -166,7 +167,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& !!$ if ((do_timings).and.(idx_phase3==-1)) & !!$ & idx_phase3 = psb_get_timer_idx("PSI_XTR_DL: phase3") - call psb_info(iictxt,me,np) + call psb_info(ictxt,me,np) if (do_timings) call psb_tic(idx_phase1) allocate(itmp(2*np+1),length_dl(0:np),stat=info) @@ -270,7 +271,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& call psb_realloc(length_dl(me),itmp,info) call psi_symm_dep_list(itmp,ictxt,info) dl_lda = max(size(itmp),1) - call psb_max(iictxt, dl_lda) + call psb_max(ictxt, dl_lda) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda @@ -282,8 +283,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& goto 9999 end if - call psb_sum(iictxt,length_dl(0:np)) - icomm = psb_get_mpi_comm(iictxt) + call psb_sum(ictxt,length_dl(0:np)) + icomm = psb_get_mpi_comm(ictxt) call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_,& & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) info = minfo @@ -298,7 +299,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& integer(psb_ipk_) :: i,j,ip,dlsym, ldu, mdl, l1, l2 dl_lda = max(length_dl(me),1) - call psb_max(iictxt, dl_lda) + call psb_max(ictxt, dl_lda) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda allocate(dep_list(dl_lda,0:np),stat=info) @@ -306,8 +307,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') goto 9999 end if - call psb_sum(iictxt,length_dl(0:np)) - icomm = psb_get_mpi_comm(iictxt) + call psb_sum(ictxt,length_dl(0:np)) + icomm = psb_get_mpi_comm(ictxt) call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_,& & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) info = minfo diff --git a/base/internals/psi_fnd_owner.F90 b/base/internals/psi_fnd_owner.F90 index f2a22e0e..06fb2494 100644 --- a/base/internals/psi_fnd_owner.F90 +++ b/base/internals/psi_fnd_owner.F90 @@ -74,7 +74,8 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) integer(psb_ipk_) :: i,n_row,n_col,err_act,ih,icomm,hsize,ip,isz,k,j,& & last_ih, last_j - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: gettime=.false. real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx character(len=20) :: name diff --git a/base/internals/psi_graph_fnd_owner.F90 b/base/internals/psi_graph_fnd_owner.F90 index 485c4806..318adcdf 100644 --- a/base/internals/psi_graph_fnd_owner.F90 +++ b/base/internals/psi_graph_fnd_owner.F90 @@ -99,12 +99,13 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) integer(psb_lpk_), allocatable :: tidx(:) integer(psb_ipk_), allocatable :: tprc(:), tsmpl(:), ladj(:) - integer(psb_mpk_) :: icomm, minfo, iictxt + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_) :: i,n_row,n_col,err_act,ip,j,ipnt, nsampl_out,& & nv, n_answers, nqries, nsampl_in, locr_max, & & nqries_max, nadj, maxspace, mxnsin integer(psb_lpk_) :: mglob, ih - integer(psb_ipk_) :: ictxt,np,me, nresp + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, nresp integer(psb_ipk_), parameter :: nt=4 integer(psb_ipk_) :: tmpv(4) logical, parameter :: do_timings=.false., trace=.false., debugsz=.false. @@ -121,7 +122,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) mglob = idxmap%get_gr() n_row = idxmap%get_lr() n_col = idxmap%get_lc() - iictxt = ictxt + if ((do_timings).and.(idx_sweep0==-1)) & & idx_sweep0 = psb_get_timer_idx("GRPH_FND_OWN: Outer sweep") if ((do_timings).and.(idx_loop_a2a==-1)) & @@ -360,7 +361,8 @@ contains integer(psb_ipk_), intent(in) :: adj(:) class(psb_indx_map), intent(inout) :: idxmap ! - integer(psb_ipk_) :: ipnt, ns_in, ns_out, n_rem, ictxt, me, np, isw + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: ipnt, ns_in, ns_out, n_rem, me, np, isw integer(psb_lpk_), allocatable :: tidx(:) integer(psb_ipk_), allocatable :: tsmpl(:) diff --git a/base/internals/psi_indx_map_fnd_owner.F90 b/base/internals/psi_indx_map_fnd_owner.F90 index 25f900f0..9641903e 100644 --- a/base/internals/psi_indx_map_fnd_owner.F90 +++ b/base/internals/psi_indx_map_fnd_owner.F90 @@ -73,11 +73,12 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) integer(psb_ipk_), allocatable :: hhidx(:) - integer(psb_mpk_) :: icomm, minfo, iictxt + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_) :: i, err_act, hsize integer(psb_lpk_) :: nv integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me, nresp + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, nresp logical, parameter :: gettime=.false. real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx character(len=20) :: name @@ -89,7 +90,6 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) ictxt = idxmap%get_ctxt() icomm = idxmap%get_mpic() mglob = idxmap%get_gr() - iictxt = ictxt call psb_info(ictxt, me, np) diff --git a/base/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 index c4e3ea07..64306364 100644 --- a/base/internals/psi_sort_dl.f90 +++ b/base/internals/psi_sort_dl.f90 @@ -85,8 +85,8 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) implicit none integer(psb_ipk_), intent(inout) :: c_dep_list(:), dl_ptr(0:), l_dep_list(0:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info ! Local variables integer(psb_ipk_), allocatable :: dg(:), dgp(:),& & idx(:), upd(:), edges(:,:), ich(:) diff --git a/base/internals/psi_symm_dep_list.F90 b/base/internals/psi_symm_dep_list.F90 index cd2894c1..fb7b8b0b 100644 --- a/base/internals/psi_symm_dep_list.F90 +++ b/base/internals/psi_symm_dep_list.F90 @@ -54,8 +54,8 @@ subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) #endif integer(psb_mpk_), intent(inout) :: rvsz(0:) integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info ! integer(psb_ipk_), allocatable :: ladj(:) @@ -70,15 +70,13 @@ subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) name = 'psi_symm_dep_list' call psb_erractionsave(err_act) - icomm = psb_get_mpi_comm(ictxt) - call psb_info(ictxt, me, np) - if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) goto 9999 endif + icomm = psb_get_mpi_comm(ictxt) nadj = size(adj) @@ -134,8 +132,8 @@ subroutine psi_symm_dep_list_norv(adj,ictxt,info) include 'mpif.h' #endif integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info ! integer(psb_mpk_), allocatable :: rvsz(:), sdsz(:) @@ -144,22 +142,21 @@ subroutine psi_symm_dep_list_norv(adj,ictxt,info) integer(psb_ipk_) :: i,n_row,n_col,err_act,hsize,ip,& & last_ih, last_j, nidx, nrecv, nadj integer(psb_ipk_) :: mglob, ih - integer(psb_ipk_) :: np,me + integer(psb_ipk_) :: np, me character(len=20) :: name info = psb_success_ name = 'psi_symm_dep_list' call psb_erractionsave(err_act) - icomm = psb_get_mpi_comm(ictxt) call psb_info(ictxt, me, np) - if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) goto 9999 endif + icomm = psb_get_mpi_comm(ictxt) nadj = size(adj) diff --git a/base/internals/psi_xtr_loc_dl.F90 b/base/internals/psi_xtr_loc_dl.F90 index c97cc7a5..5ae93cdb 100644 --- a/base/internals/psi_xtr_loc_dl.F90 +++ b/base/internals/psi_xtr_loc_dl.F90 @@ -122,11 +122,11 @@ subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) include 'mpif.h' #endif ! ....scalar parameters... - logical, intent(in) :: is_bld, is_upd - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: desc_str(:) + logical, intent(in) :: is_bld, is_upd + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: desc_str(:) integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:) - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info ! .....local arrays.... integer(psb_ipk_) :: int_err(5) @@ -134,7 +134,7 @@ subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) integer(psb_ipk_) :: i,pdl,proc,j,err_act, ldu integer(psb_ipk_) :: err integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt, icomm, me, np, minfo + integer(psb_ipk_) :: me, np logical, parameter :: dist_symm_list=.true., print_dl=.false., profile=.true. character name*20 name='psi_extrct_dl' @@ -142,10 +142,9 @@ subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - iictxt = ictxt info = psb_success_ - call psb_info(iictxt,me,np) + call psb_info(ictxt,me,np) pdl = size(desc_str) allocate(loc_dl(pdl+1),length_dl(0:np),stat=info) if (info /= psb_success_) then diff --git a/base/modules/Makefile b/base/modules/Makefile index 238ab9ca..4d01299f 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -1,6 +1,7 @@ include ../../Make.inc BASIC_MODS= psb_const_mod.o psb_cbind_const_mod.o psb_error_mod.o psb_realloc_mod.o \ + auxil/psb_string_mod.o \ auxil/psb_m_realloc_mod.o \ auxil/psb_e_realloc_mod.o \ auxil/psb_s_realloc_mod.o \ @@ -8,8 +9,8 @@ BASIC_MODS= psb_const_mod.o psb_cbind_const_mod.o psb_error_mod.o psb_realloc_mo auxil/psb_c_realloc_mod.o \ auxil/psb_z_realloc_mod.o -COMMINT=penv/psi_penv_mod.o \ - penv/psi_p2p_mod.o penv/psi_m_p2p_mod.o \ +COMMINT= penv/psi_penv_mod.o \ + penv/psi_p2p_mod.o penv/psi_m_p2p_mod.o \ penv/psi_e_p2p_mod.o \ penv/psi_s_p2p_mod.o \ penv/psi_d_p2p_mod.o \ @@ -23,38 +24,9 @@ COMMINT=penv/psi_penv_mod.o \ penv/psi_c_collective_mod.o \ penv/psi_z_collective_mod.o -UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\ - desc/psb_gen_block_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o\ - desc/psb_glist_map_mod.o desc/psb_hash_map_mod.o desc/psb_hashval.o \ - desc/psb_desc_mod.o auxil/psb_sort_mod.o \ - serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o \ +SERIAL_MODS=serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o \ serial/psb_c_serial_mod.o serial/psb_z_serial_mod.o \ serial/psb_serial_mod.o \ - tools/psb_cd_tools_mod.o \ - tools/psb_i_tools_mod.o tools/psb_l_tools_mod.o \ - tools/psb_s_tools_mod.o tools/psb_d_tools_mod.o\ - tools/psb_c_tools_mod.o tools/psb_z_tools_mod.o \ - tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \ - tools/psb_s_tools_a_mod.o tools/psb_d_tools_a_mod.o\ - tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o \ - tools/psb_tools_mod.o \ - psb_penv_mod.o $(COMMINT) psb_error_impl.o psb_timers_mod.o \ - comm/psb_base_linmap_mod.o comm/psb_linmap_mod.o \ - comm/psb_s_linmap_mod.o comm/psb_d_linmap_mod.o \ - comm/psb_c_linmap_mod.o comm/psb_z_linmap_mod.o \ - comm/psb_comm_mod.o \ - comm/psb_i_comm_mod.o comm/psb_l_comm_mod.o \ - comm/psb_s_comm_mod.o comm/psb_d_comm_mod.o\ - comm/psb_c_comm_mod.o comm/psb_z_comm_mod.o \ - comm/psb_m_comm_a_mod.o comm/psb_e_comm_a_mod.o \ - comm/psb_s_comm_a_mod.o comm/psb_d_comm_a_mod.o\ - comm/psb_c_comm_a_mod.o comm/psb_z_comm_a_mod.o \ - comm/psi_e_comm_a_mod.o comm/psi_m_comm_a_mod.o \ - comm/psi_s_comm_a_mod.o comm/psi_d_comm_a_mod.o \ - comm/psi_c_comm_a_mod.o comm/psi_z_comm_a_mod.o \ - comm/psi_i_comm_v_mod.o comm/psi_l_comm_v_mod.o \ - comm/psi_s_comm_v_mod.o comm/psi_d_comm_v_mod.o \ - comm/psi_c_comm_v_mod.o comm/psi_z_comm_v_mod.o \ serial/psb_i_base_vect_mod.o serial/psb_i_vect_mod.o\ serial/psb_l_base_vect_mod.o serial/psb_l_vect_mod.o\ serial/psb_d_base_vect_mod.o serial/psb_d_vect_mod.o\ @@ -62,9 +34,6 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m serial/psb_c_base_vect_mod.o serial/psb_c_vect_mod.o\ serial/psb_z_base_vect_mod.o serial/psb_z_vect_mod.o\ serial/psb_vect_mod.o\ - psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o \ - psblas/psb_d_psblas_mod.o psblas/psb_z_psblas_mod.o \ - psblas/psb_psblas_mod.o \ auxil/psi_serial_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \ auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o \ auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o \ @@ -91,7 +60,6 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m auxil/psb_d_hsort_x_mod.o \ auxil/psb_c_hsort_x_mod.o \ auxil/psb_z_hsort_x_mod.o \ - psb_check_mod.o desc/psb_hash_mod.o\ serial/psb_base_mat_mod.o serial/psb_mat_mod.o\ serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_mat_mod.o \ serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_mat_mod.o \ @@ -102,9 +70,43 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m #\ # serial/psb_ld_base_mat_mod.o serial/psb_lbase_mat_mod.o serial/psb_ld_csc_mat_mod.o serial/psb_ld_csr_mat_mod.o +UTIL_MODS = desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\ + desc/psb_gen_block_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o\ + desc/psb_glist_map_mod.o desc/psb_hash_map_mod.o desc/psb_hashval.o \ + desc/psb_desc_mod.o auxil/psb_sort_mod.o \ + tools/psb_cd_tools_mod.o \ + tools/psb_i_tools_mod.o tools/psb_l_tools_mod.o \ + tools/psb_s_tools_mod.o tools/psb_d_tools_mod.o\ + tools/psb_c_tools_mod.o tools/psb_z_tools_mod.o \ + tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \ + tools/psb_s_tools_a_mod.o tools/psb_d_tools_a_mod.o\ + tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o \ + tools/psb_tools_mod.o \ + psb_penv_mod.o $(COMMINT) psb_error_impl.o psb_timers_mod.o \ + comm/psb_base_linmap_mod.o comm/psb_linmap_mod.o \ + comm/psb_s_linmap_mod.o comm/psb_d_linmap_mod.o \ + comm/psb_c_linmap_mod.o comm/psb_z_linmap_mod.o \ + comm/psb_comm_mod.o \ + comm/psb_i_comm_mod.o comm/psb_l_comm_mod.o \ + comm/psb_s_comm_mod.o comm/psb_d_comm_mod.o\ + comm/psb_c_comm_mod.o comm/psb_z_comm_mod.o \ + comm/psb_m_comm_a_mod.o comm/psb_e_comm_a_mod.o \ + comm/psb_s_comm_a_mod.o comm/psb_d_comm_a_mod.o\ + comm/psb_c_comm_a_mod.o comm/psb_z_comm_a_mod.o \ + comm/psi_e_comm_a_mod.o comm/psi_m_comm_a_mod.o \ + comm/psi_s_comm_a_mod.o comm/psi_d_comm_a_mod.o \ + comm/psi_c_comm_a_mod.o comm/psi_z_comm_a_mod.o \ + comm/psi_i_comm_v_mod.o comm/psi_l_comm_v_mod.o \ + comm/psi_s_comm_v_mod.o comm/psi_d_comm_v_mod.o \ + comm/psi_c_comm_v_mod.o comm/psi_z_comm_v_mod.o \ + psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o \ + psblas/psb_d_psblas_mod.o psblas/psb_z_psblas_mod.o \ + psblas/psb_psblas_mod.o \ + psb_check_mod.o desc/psb_hash_mod.o + -MODULES=$(BASIC_MODS) $(UTIL_MODS) +MODULES=$(BASIC_MODS) $(SERIAL_MODS) $(UTIL_MODS) OBJS = error.o psb_base_mod.o $(EXTRA_COBJS) cutil.o LIBDIR=.. CINCLUDES=-I. @@ -118,8 +120,8 @@ $(LIBDIR)/$(LIBNAME): $(MODULES) $(OBJS) $(MPFOBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) - -psb_error_mod.o: psb_const_mod.o +$(OBJS): $(MODULES) +psb_error_mod.o: psb_const_mod.o psb_realloc_mod.o \ auxil/psb_m_realloc_mod.o \ auxil/psb_e_realloc_mod.o \ @@ -161,7 +163,7 @@ penv/psi_d_collective_mod.o penv/psi_c_collective_mod.o penv/psi_z_collective_m auxil/psb_string_mod.o desc/psb_desc_const_mod.o psi_penv_mod.o: psb_const_mod.o -desc/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o desc/psb_desc_const_mod.o +desc/psb_indx_map_mod.o desc/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o desc/psb_desc_const_mod.o auxil/psb_i_sort_mod.o auxil/psb_s_sort_mod.o auxil/psb_d_sort_mod.o auxil/psb_c_sort_mod.o auxil/psb_z_sort_mod.o \ auxil/psb_ip_reord_mod.o auxil/psi_serial_mod.o auxil/psb_sort_mod.o: $(BASIC_MODS) auxil/psb_sort_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \ @@ -272,7 +274,7 @@ desc/psb_glist_map_mod.o: desc/psb_list_map_mod.o desc/psb_hash_map_mod.o: desc/psb_hash_mod.o auxil/psb_sort_mod.o desc/psb_gen_block_map_mod.o: desc/psb_hash_mod.o desc/psb_hash_mod.o: psb_cbind_const_mod.o - +psb_cbind_const_mod.o: psb_const_mod.o psb_check_mod.o: desc/psb_desc_mod.o comm/psb_linmap_mod.o: comm/psb_s_linmap_mod.o comm/psb_d_linmap_mod.o comm/psb_c_linmap_mod.o comm/psb_z_linmap_mod.o @@ -346,7 +348,7 @@ psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o psblas/psb_d_psblas_mod.o ps psb_base_mod.o: $(MODULES) -penv/psi_penv_mod.o: penv/psi_penv_mod.F90 $(BASIC_MODS) serial/psb_vect_mod.o serial/psb_mat_mod.o +penv/psi_penv_mod.o: penv/psi_penv_mod.F90 psb_const_mod.o serial/psb_vect_mod.o serial/psb_mat_mod.o $(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@ psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS) diff --git a/base/modules/comm/psb_c_comm_a_mod.f90 b/base/modules/comm/psb_c_comm_a_mod.f90 index 5d0b236e..0fbcf01e 100644 --- a/base/modules/comm/psb_c_comm_a_mod.f90 +++ b/base/modules/comm/psb_c_comm_a_mod.f90 @@ -38,7 +38,7 @@ module psb_c_comm_a_mod implicit none complex(psb_spk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info complex(psb_spk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_covrlm @@ -47,7 +47,7 @@ module psb_c_comm_a_mod implicit none complex(psb_spk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info complex(psb_spk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_covrlv @@ -68,8 +68,8 @@ module psb_c_comm_a_mod import implicit none complex(psb_spk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info complex(psb_spk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psb_d_comm_a_mod.f90 b/base/modules/comm/psb_d_comm_a_mod.f90 index 8053f2d5..5fb410f2 100644 --- a/base/modules/comm/psb_d_comm_a_mod.f90 +++ b/base/modules/comm/psb_d_comm_a_mod.f90 @@ -38,7 +38,7 @@ module psb_d_comm_a_mod implicit none real(psb_dpk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info real(psb_dpk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_dovrlm @@ -47,7 +47,7 @@ module psb_d_comm_a_mod implicit none real(psb_dpk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info real(psb_dpk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_dovrlv @@ -68,8 +68,8 @@ module psb_d_comm_a_mod import implicit none real(psb_dpk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info real(psb_dpk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psb_e_comm_a_mod.f90 b/base/modules/comm/psb_e_comm_a_mod.f90 index 46057d94..0e57a459 100644 --- a/base/modules/comm/psb_e_comm_a_mod.f90 +++ b/base/modules/comm/psb_e_comm_a_mod.f90 @@ -39,7 +39,7 @@ module psb_e_comm_a_mod implicit none integer(psb_epk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_epk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_eovrlm @@ -48,7 +48,7 @@ module psb_e_comm_a_mod implicit none integer(psb_epk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_epk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_eovrlv @@ -69,8 +69,8 @@ module psb_e_comm_a_mod import implicit none integer(psb_epk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info integer(psb_epk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psb_i2_comm_a_mod.f90 b/base/modules/comm/psb_i2_comm_a_mod.f90 index 09398722..72cdf228 100644 --- a/base/modules/comm/psb_i2_comm_a_mod.f90 +++ b/base/modules/comm/psb_i2_comm_a_mod.f90 @@ -39,7 +39,7 @@ module psb_i2_comm_a_mod implicit none integer(psb_i2pk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_i2ovrlm @@ -48,7 +48,7 @@ module psb_i2_comm_a_mod implicit none integer(psb_i2pk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_i2ovrlv @@ -69,8 +69,8 @@ module psb_i2_comm_a_mod import implicit none integer(psb_i2pk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psb_m_comm_a_mod.f90 b/base/modules/comm/psb_m_comm_a_mod.f90 index dbec118a..105f14d7 100644 --- a/base/modules/comm/psb_m_comm_a_mod.f90 +++ b/base/modules/comm/psb_m_comm_a_mod.f90 @@ -39,7 +39,7 @@ module psb_m_comm_a_mod implicit none integer(psb_mpk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_movrlm @@ -48,7 +48,7 @@ module psb_m_comm_a_mod implicit none integer(psb_mpk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_movrlv @@ -69,8 +69,8 @@ module psb_m_comm_a_mod import implicit none integer(psb_mpk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psb_s_comm_a_mod.f90 b/base/modules/comm/psb_s_comm_a_mod.f90 index 9e7a768a..5ceaad8b 100644 --- a/base/modules/comm/psb_s_comm_a_mod.f90 +++ b/base/modules/comm/psb_s_comm_a_mod.f90 @@ -38,7 +38,7 @@ module psb_s_comm_a_mod implicit none real(psb_spk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info real(psb_spk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_sovrlm @@ -47,7 +47,7 @@ module psb_s_comm_a_mod implicit none real(psb_spk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info real(psb_spk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_sovrlv @@ -68,8 +68,8 @@ module psb_s_comm_a_mod import implicit none real(psb_spk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info real(psb_spk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psb_z_comm_a_mod.f90 b/base/modules/comm/psb_z_comm_a_mod.f90 index 0c276945..708efead 100644 --- a/base/modules/comm/psb_z_comm_a_mod.f90 +++ b/base/modules/comm/psb_z_comm_a_mod.f90 @@ -38,7 +38,7 @@ module psb_z_comm_a_mod implicit none complex(psb_dpk_), intent(inout), target :: x(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode end subroutine psb_zovrlm @@ -47,7 +47,7 @@ module psb_z_comm_a_mod implicit none complex(psb_dpk_), intent(inout), target :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(in), optional :: update,mode end subroutine psb_zovrlv @@ -68,8 +68,8 @@ module psb_z_comm_a_mod import implicit none complex(psb_dpk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_), target, optional, intent(inout) :: work(:) integer(psb_ipk_), intent(in), optional :: mode,data character, intent(in), optional :: tran diff --git a/base/modules/comm/psi_c_comm_a_mod.f90 b/base/modules/comm/psi_c_comm_a_mod.f90 index 030d7465..05724a9d 100644 --- a/base/modules/comm/psi_c_comm_a_mod.f90 +++ b/base/modules/comm/psi_c_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_c_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_spk_, psb_i_base_vect_type interface psi_swapdata subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_c_comm_a_mod subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_c_comm_a_mod subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:), beta complex(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_c_comm_a_mod subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:,:), beta complex(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_c_comm_a_mod subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_spk_) :: y(:), beta complex(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_c_comm_a_mod subroutine psi_covrl_updr1(x,desc_a,update,info) import complex(psb_spk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_covrl_updr1 subroutine psi_covrl_updr2(x,desc_a,update,info) import complex(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_covrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_c_comm_a_mod complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_covrl_saver1 subroutine psi_covrl_saver2(x,xs,desc_a,info) import complex(psb_spk_), intent(inout) :: x(:,:) complex(psb_spk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_covrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_c_comm_a_mod complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_covrl_restrr1 subroutine psi_covrl_restrr2(x,xs,desc_a,info) import complex(psb_spk_), intent(inout) :: x(:,:) complex(psb_spk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_covrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_c_comm_v_mod.f90 b/base/modules/comm/psi_c_comm_v_mod.f90 index 78fee8ae..3a2037a2 100644 --- a/base/modules/comm/psi_c_comm_v_mod.f90 +++ b/base/modules/comm/psi_c_comm_v_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_c_comm_v_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_spk_, psb_i_base_vect_type use psb_c_base_vect_mod, only : psb_c_base_vect_type use psb_c_base_multivect_mod, only : psb_c_base_multivect_type @@ -43,7 +44,7 @@ module psi_c_comm_v_mod complex(psb_spk_) :: beta complex(psb_spk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_cswapdata_vect subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data) import @@ -53,12 +54,14 @@ module psi_c_comm_v_mod complex(psb_spk_) :: beta complex(psb_spk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_cswapdata_multivect subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_c_base_vect_type) :: y complex(psb_spk_) :: beta @@ -69,9 +72,11 @@ module psi_c_comm_v_mod subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_c_base_multivect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_multivect_type) :: y complex(psb_spk_) :: beta complex(psb_spk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -104,9 +109,11 @@ module psi_c_comm_v_mod subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_c_base_vect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_vect_type) :: y complex(psb_spk_) :: beta complex(psb_spk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -115,8 +122,10 @@ module psi_c_comm_v_mod subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_c_base_multivect_type) :: y complex(psb_spk_) :: beta complex(psb_spk_), target :: work(:) diff --git a/base/modules/comm/psi_d_comm_a_mod.f90 b/base/modules/comm/psi_d_comm_a_mod.f90 index 43b74b1d..c8bcc3a2 100644 --- a/base/modules/comm/psi_d_comm_a_mod.f90 +++ b/base/modules/comm/psi_d_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_d_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_dpk_, psb_i_base_vect_type interface psi_swapdata subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_d_comm_a_mod subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_d_comm_a_mod subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:), beta real(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_d_comm_a_mod subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:,:), beta real(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_d_comm_a_mod subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_dpk_) :: y(:), beta real(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_d_comm_a_mod subroutine psi_dovrl_updr1(x,desc_a,update,info) import real(psb_dpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_dovrl_updr1 subroutine psi_dovrl_updr2(x,desc_a,update,info) import real(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_dovrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_d_comm_a_mod real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_dovrl_saver1 subroutine psi_dovrl_saver2(x,xs,desc_a,info) import real(psb_dpk_), intent(inout) :: x(:,:) real(psb_dpk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_dovrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_d_comm_a_mod real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_dovrl_restrr1 subroutine psi_dovrl_restrr2(x,xs,desc_a,info) import real(psb_dpk_), intent(inout) :: x(:,:) real(psb_dpk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_dovrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_d_comm_v_mod.f90 b/base/modules/comm/psi_d_comm_v_mod.f90 index 41aeab6f..bee737af 100644 --- a/base/modules/comm/psi_d_comm_v_mod.f90 +++ b/base/modules/comm/psi_d_comm_v_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_d_comm_v_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_dpk_, psb_i_base_vect_type use psb_d_base_vect_mod, only : psb_d_base_vect_type use psb_d_base_multivect_mod, only : psb_d_base_multivect_type @@ -43,7 +44,7 @@ module psi_d_comm_v_mod real(psb_dpk_) :: beta real(psb_dpk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_dswapdata_vect subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data) import @@ -53,12 +54,14 @@ module psi_d_comm_v_mod real(psb_dpk_) :: beta real(psb_dpk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_dswapdata_multivect subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_d_base_vect_type) :: y real(psb_dpk_) :: beta @@ -69,9 +72,11 @@ module psi_d_comm_v_mod subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_d_base_multivect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_d_base_multivect_type) :: y real(psb_dpk_) :: beta real(psb_dpk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -104,9 +109,11 @@ module psi_d_comm_v_mod subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_d_base_vect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_d_base_vect_type) :: y real(psb_dpk_) :: beta real(psb_dpk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -115,8 +122,10 @@ module psi_d_comm_v_mod subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_d_base_multivect_type) :: y real(psb_dpk_) :: beta real(psb_dpk_), target :: work(:) diff --git a/base/modules/comm/psi_e_comm_a_mod.f90 b/base/modules/comm/psi_e_comm_a_mod.f90 index 98522486..8f268a8f 100644 --- a/base/modules/comm/psi_e_comm_a_mod.f90 +++ b/base/modules/comm/psi_e_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_e_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_ + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_epk_ interface psi_swapdata subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_e_comm_a_mod subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_e_comm_a_mod subroutine psi_eswapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:), beta integer(psb_epk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_e_comm_a_mod subroutine psi_etranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:,:), beta integer(psb_epk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_e_comm_a_mod subroutine psi_etranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_epk_) :: y(:), beta integer(psb_epk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_e_comm_a_mod subroutine psi_eovrl_updr1(x,desc_a,update,info) import integer(psb_epk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_eovrl_updr1 subroutine psi_eovrl_updr2(x,desc_a,update,info) import integer(psb_epk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_eovrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_e_comm_a_mod integer(psb_epk_), intent(inout) :: x(:) integer(psb_epk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_eovrl_saver1 subroutine psi_eovrl_saver2(x,xs,desc_a,info) import integer(psb_epk_), intent(inout) :: x(:,:) integer(psb_epk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_eovrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_e_comm_a_mod integer(psb_epk_), intent(inout) :: x(:) integer(psb_epk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_eovrl_restrr1 subroutine psi_eovrl_restrr2(x,xs,desc_a,info) import integer(psb_epk_), intent(inout) :: x(:,:) integer(psb_epk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_eovrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_i2_comm_a_mod.f90 b/base/modules/comm/psi_i2_comm_a_mod.f90 index f67b5654..b16d1621 100644 --- a/base/modules/comm/psi_i2_comm_a_mod.f90 +++ b/base/modules/comm/psi_i2_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_i2_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_ + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_epk_ interface psi_swapdata subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_i2_comm_a_mod subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_i2_comm_a_mod subroutine psi_i2swapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_i2_comm_a_mod subroutine psi_i2tranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:,:), beta integer(psb_i2pk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_i2_comm_a_mod subroutine psi_i2tranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_i2pk_) :: y(:), beta integer(psb_i2pk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_i2_comm_a_mod subroutine psi_i2ovrl_updr1(x,desc_a,update,info) import integer(psb_i2pk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_i2ovrl_updr1 subroutine psi_i2ovrl_updr2(x,desc_a,update,info) import integer(psb_i2pk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_i2ovrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_i2_comm_a_mod integer(psb_i2pk_), intent(inout) :: x(:) integer(psb_i2pk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_i2ovrl_saver1 subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) import integer(psb_i2pk_), intent(inout) :: x(:,:) integer(psb_i2pk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_i2ovrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_i2_comm_a_mod integer(psb_i2pk_), intent(inout) :: x(:) integer(psb_i2pk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_i2ovrl_restrr1 subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) import integer(psb_i2pk_), intent(inout) :: x(:,:) integer(psb_i2pk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_i2ovrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_i_comm_v_mod.f90 b/base/modules/comm/psi_i_comm_v_mod.f90 index bc4ea2a8..6e10eb80 100644 --- a/base/modules/comm/psi_i_comm_v_mod.f90 +++ b/base/modules/comm/psi_i_comm_v_mod.f90 @@ -30,6 +30,7 @@ ! ! module psi_i_comm_v_mod + use psi_penv_mod, only : psb_ctxt_type use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, & & psb_lpk_, psb_epk_, psb_i2pk_ use psb_i_base_vect_mod, only : psb_i_base_vect_type @@ -44,7 +45,7 @@ module psi_i_comm_v_mod integer(psb_ipk_) :: beta integer(psb_ipk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_iswapdata_vect subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data) import @@ -54,12 +55,14 @@ module psi_i_comm_v_mod integer(psb_ipk_) :: beta integer(psb_ipk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_iswapdata_multivect subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_i_base_vect_type) :: y integer(psb_ipk_) :: beta @@ -70,9 +73,11 @@ module psi_i_comm_v_mod subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_i_base_multivect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_i_base_multivect_type) :: y integer(psb_ipk_) :: beta integer(psb_ipk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -105,9 +110,11 @@ module psi_i_comm_v_mod subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_i_base_vect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_i_base_vect_type) :: y integer(psb_ipk_) :: beta integer(psb_ipk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -116,8 +123,10 @@ module psi_i_comm_v_mod subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_i_base_multivect_type) :: y integer(psb_ipk_) :: beta integer(psb_ipk_), target :: work(:) diff --git a/base/modules/comm/psi_l_comm_v_mod.f90 b/base/modules/comm/psi_l_comm_v_mod.f90 index 4c80b090..375c15de 100644 --- a/base/modules/comm/psi_l_comm_v_mod.f90 +++ b/base/modules/comm/psi_l_comm_v_mod.f90 @@ -30,6 +30,7 @@ ! ! module psi_l_comm_v_mod + use psi_penv_mod, only : psb_ctxt_type use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, & & psb_lpk_, psb_epk_, psb_i2pk_ use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_lpk_, psb_epk_, psb_i_base_vect_type @@ -45,7 +46,7 @@ module psi_l_comm_v_mod integer(psb_lpk_) :: beta integer(psb_lpk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_lswapdata_vect subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data) import @@ -55,12 +56,14 @@ module psi_l_comm_v_mod integer(psb_lpk_) :: beta integer(psb_lpk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_lswapdata_multivect subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_l_base_vect_type) :: y integer(psb_lpk_) :: beta @@ -71,9 +74,11 @@ module psi_l_comm_v_mod subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_l_base_multivect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_l_base_multivect_type) :: y integer(psb_lpk_) :: beta integer(psb_lpk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -106,9 +111,11 @@ module psi_l_comm_v_mod subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_l_base_vect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_l_base_vect_type) :: y integer(psb_lpk_) :: beta integer(psb_lpk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -117,8 +124,10 @@ module psi_l_comm_v_mod subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_l_base_multivect_type) :: y integer(psb_lpk_) :: beta integer(psb_lpk_), target :: work(:) diff --git a/base/modules/comm/psi_m_comm_a_mod.f90 b/base/modules/comm/psi_m_comm_a_mod.f90 index 4d0608c3..58ff0214 100644 --- a/base/modules/comm/psi_m_comm_a_mod.f90 +++ b/base/modules/comm/psi_m_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_m_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_ + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_epk_ interface psi_swapdata subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_m_comm_a_mod subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_m_comm_a_mod subroutine psi_mswapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:), beta integer(psb_mpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_m_comm_a_mod subroutine psi_mtranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:,:), beta integer(psb_mpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_m_comm_a_mod subroutine psi_mtranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info integer(psb_mpk_) :: y(:), beta integer(psb_mpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_m_comm_a_mod subroutine psi_movrl_updr1(x,desc_a,update,info) import integer(psb_mpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_movrl_updr1 subroutine psi_movrl_updr2(x,desc_a,update,info) import integer(psb_mpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_movrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_m_comm_a_mod integer(psb_mpk_), intent(inout) :: x(:) integer(psb_mpk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_movrl_saver1 subroutine psi_movrl_saver2(x,xs,desc_a,info) import integer(psb_mpk_), intent(inout) :: x(:,:) integer(psb_mpk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_movrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_m_comm_a_mod integer(psb_mpk_), intent(inout) :: x(:) integer(psb_mpk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_movrl_restrr1 subroutine psi_movrl_restrr2(x,xs,desc_a,info) import integer(psb_mpk_), intent(inout) :: x(:,:) integer(psb_mpk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_movrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_s_comm_a_mod.f90 b/base/modules/comm/psi_s_comm_a_mod.f90 index e3fdabb2..8320dd9f 100644 --- a/base/modules/comm/psi_s_comm_a_mod.f90 +++ b/base/modules/comm/psi_s_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_s_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_spk_, psb_i_base_vect_type interface psi_swapdata subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_s_comm_a_mod subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_s_comm_a_mod subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:), beta real(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_s_comm_a_mod subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:,:), beta real(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_s_comm_a_mod subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info real(psb_spk_) :: y(:), beta real(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_s_comm_a_mod subroutine psi_sovrl_updr1(x,desc_a,update,info) import real(psb_spk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_sovrl_updr1 subroutine psi_sovrl_updr2(x,desc_a,update,info) import real(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_sovrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_s_comm_a_mod real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_sovrl_saver1 subroutine psi_sovrl_saver2(x,xs,desc_a,info) import real(psb_spk_), intent(inout) :: x(:,:) real(psb_spk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_sovrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_s_comm_a_mod real(psb_spk_), intent(inout) :: x(:) real(psb_spk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_sovrl_restrr1 subroutine psi_sovrl_restrr2(x,xs,desc_a,info) import real(psb_spk_), intent(inout) :: x(:,:) real(psb_spk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_sovrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_s_comm_v_mod.f90 b/base/modules/comm/psi_s_comm_v_mod.f90 index 9e7f525d..419d6967 100644 --- a/base/modules/comm/psi_s_comm_v_mod.f90 +++ b/base/modules/comm/psi_s_comm_v_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_s_comm_v_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_spk_, psb_i_base_vect_type use psb_s_base_vect_mod, only : psb_s_base_vect_type use psb_s_base_multivect_mod, only : psb_s_base_multivect_type @@ -43,7 +44,7 @@ module psi_s_comm_v_mod real(psb_spk_) :: beta real(psb_spk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_sswapdata_vect subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data) import @@ -53,12 +54,14 @@ module psi_s_comm_v_mod real(psb_spk_) :: beta real(psb_spk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_sswapdata_multivect subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_s_base_vect_type) :: y real(psb_spk_) :: beta @@ -69,9 +72,11 @@ module psi_s_comm_v_mod subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_s_base_multivect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_multivect_type) :: y real(psb_spk_) :: beta real(psb_spk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -104,9 +109,11 @@ module psi_s_comm_v_mod subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_s_base_vect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_vect_type) :: y real(psb_spk_) :: beta real(psb_spk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -115,8 +122,10 @@ module psi_s_comm_v_mod subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_s_base_multivect_type) :: y real(psb_spk_) :: beta real(psb_spk_), target :: work(:) diff --git a/base/modules/comm/psi_z_comm_a_mod.f90 b/base/modules/comm/psi_z_comm_a_mod.f90 index c3dcd876..109fc60c 100644 --- a/base/modules/comm/psi_z_comm_a_mod.f90 +++ b/base/modules/comm/psi_z_comm_a_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_z_comm_a_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_mpk_, psb_ipk_, psb_dpk_, psb_i_base_vect_type interface psi_swapdata subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) @@ -54,8 +55,10 @@ module psi_z_comm_a_mod subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -63,8 +66,10 @@ module psi_z_comm_a_mod subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_Mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:), beta complex(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -94,8 +99,10 @@ module psi_z_comm_a_mod subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag, n + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:,:), beta complex(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -103,8 +110,10 @@ module psi_z_comm_a_mod subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: ictxt,icomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: icomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info complex(psb_dpk_) :: y(:), beta complex(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv @@ -115,16 +124,16 @@ module psi_z_comm_a_mod subroutine psi_zovrl_updr1(x,desc_a,update,info) import complex(psb_dpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_zovrl_updr1 subroutine psi_zovrl_updr2(x,desc_a,update,info) import complex(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(in) :: update - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(in) :: update + integer(psb_ipk_), intent(out) :: info end subroutine psi_zovrl_updr2 end interface psi_ovrl_upd @@ -134,14 +143,14 @@ module psi_z_comm_a_mod complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), allocatable :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_zovrl_saver1 subroutine psi_zovrl_saver2(x,xs,desc_a,info) import complex(psb_dpk_), intent(inout) :: x(:,:) complex(psb_dpk_), allocatable :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_zovrl_saver2 end interface psi_ovrl_save @@ -151,14 +160,14 @@ module psi_z_comm_a_mod complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_) :: xs(:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_zovrl_restrr1 subroutine psi_zovrl_restrr2(x,xs,desc_a,info) import complex(psb_dpk_), intent(inout) :: x(:,:) complex(psb_dpk_) :: xs(:,:) type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_zovrl_restrr2 end interface psi_ovrl_restore diff --git a/base/modules/comm/psi_z_comm_v_mod.f90 b/base/modules/comm/psi_z_comm_v_mod.f90 index 9e9816e6..58341880 100644 --- a/base/modules/comm/psi_z_comm_v_mod.f90 +++ b/base/modules/comm/psi_z_comm_v_mod.f90 @@ -30,7 +30,8 @@ ! ! module psi_z_comm_v_mod - use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type + use psi_penv_mod, only : psb_ctxt_type + use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_dpk_, psb_i_base_vect_type use psb_z_base_vect_mod, only : psb_z_base_vect_type use psb_z_base_multivect_mod, only : psb_z_base_multivect_type @@ -43,7 +44,7 @@ module psi_z_comm_v_mod complex(psb_dpk_) :: beta complex(psb_dpk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_zswapdata_vect subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data) import @@ -53,12 +54,14 @@ module psi_z_comm_v_mod complex(psb_dpk_) :: beta complex(psb_dpk_),target :: work(:) type(psb_desc_type), target :: desc_a - integer(psb_ipk_), optional :: data + integer(psb_ipk_), optional :: data end subroutine psi_zswapdata_multivect subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info class(psb_z_base_vect_type) :: y complex(psb_dpk_) :: beta @@ -69,9 +72,11 @@ module psi_z_comm_v_mod subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_z_base_multivect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_multivect_type) :: y complex(psb_dpk_) :: beta complex(psb_dpk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -104,9 +109,11 @@ module psi_z_comm_v_mod subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info - class(psb_z_base_vect_type) :: y + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_vect_type) :: y complex(psb_dpk_) :: beta complex(psb_dpk_), target :: work(:) class(psb_i_base_vect_type), intent(inout) :: idx @@ -115,8 +122,10 @@ module psi_z_comm_v_mod subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type), intent(in) :: iictxt + integer(psb_mpk_), intent(in) :: iicomm + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info class(psb_z_base_multivect_type) :: y complex(psb_dpk_) :: beta complex(psb_dpk_), target :: work(:) diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index 6378c699..8d2c6190 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -1,4 +1,4 @@ - +! ! Parallel Sparse BLAS version 3.5 ! (C) Copyright 2006-2018 ! Salvatore Filippone @@ -399,8 +399,8 @@ contains use psb_penv_mod implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_lpk_), intent(in) :: m + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_lpk_), intent(in) :: m logical :: val !locals integer(psb_ipk_) :: np,me @@ -435,7 +435,7 @@ contains function psb_is_ok_desc(desc) result(val) implicit none class(psb_desc_type), intent(in) :: desc - logical :: val + logical :: val val = .false. if (allocated(desc%indxmap)) & @@ -446,7 +446,7 @@ contains function psb_is_valid_desc(desc) result(val) implicit none class(psb_desc_type), intent(in) :: desc - logical :: val + logical :: val val = .false. if (allocated(desc%indxmap)) & @@ -468,7 +468,7 @@ contains function psb_is_upd_desc(desc) result(val) implicit none class(psb_desc_type), intent(in) :: desc - logical :: val + logical :: val val = .false. if (allocated(desc%indxmap)) & @@ -479,7 +479,7 @@ contains function psb_is_repl_desc(desc) result(val) implicit none class(psb_desc_type), intent(in) :: desc - logical :: val + logical :: val val = .false. if (allocated(desc%indxmap)) & @@ -490,7 +490,7 @@ contains function psb_is_ovl_desc(desc) result(val) implicit none class(psb_desc_type), intent(in) :: desc - logical :: val + logical :: val val = .false. if (allocated(desc%indxmap)) & @@ -502,7 +502,7 @@ contains function psb_is_asb_desc(desc) result(val) implicit none class(psb_desc_type), intent(in) :: desc - logical :: val + logical :: val val = .false. if (allocated(desc%indxmap)) & @@ -608,12 +608,11 @@ contains function psb_cd_get_context(desc) result(val) use psb_error_mod implicit none - integer(psb_ipk_) :: val + type(psb_ctxt_type) :: val class(psb_desc_type), intent(in) :: desc if (allocated(desc%indxmap)) then val = desc%indxmap%get_ctxt() else - val = -1 call psb_errpush(psb_err_invalid_cd_state_,'psb_cd_get_context') call psb_error() end if @@ -745,15 +744,16 @@ contains use psb_penv_mod implicit none - integer(psb_ipk_), intent(in) :: data - integer(psb_ipk_), pointer :: ipnt(:) - class(psb_desc_type), target :: desc - integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info + integer(psb_ipk_), intent(in) :: data + integer(psb_ipk_), pointer :: ipnt(:) + class(psb_desc_type), target :: desc + integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info !locals - integer(psb_ipk_) :: np,me,ictxt,err_act, debug_level,debug_unit - logical, parameter :: debug=.false.,debugprt=.false. - character(len=20), parameter :: name='psb_cd_get_list' + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, debug_level, debug_unit + logical, parameter :: debug=.false., debugprt=.false. + character(len=20), parameter :: name='psb_cd_get_list' info = psb_success_ call psb_erractionsave(err_act) @@ -809,15 +809,16 @@ contains use psb_error_mod use psb_penv_mod implicit none - integer(psb_ipk_), intent(in) :: data - class(psb_i_base_vect_type), pointer :: ipnt - class(psb_desc_type), target :: desc - integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info + integer(psb_ipk_), intent(in) :: data + class(psb_i_base_vect_type), pointer :: ipnt + class(psb_desc_type), target :: desc + integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info !locals - integer(psb_ipk_) :: np,me,ictxt,err_act, debug_level,debug_unit - logical, parameter :: debug=.false.,debugprt=.false. - character(len=20), parameter :: name='psb_cd_v_get_list' + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act, debug_level, debug_unit + logical, parameter :: debug=.false., debugprt=.false. + character(len=20), parameter :: name='psb_cd_v_get_list' info = psb_success_ call psb_erractionsave(err_act) @@ -895,7 +896,8 @@ contains class(psb_desc_type), intent(inout) :: desc integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act character(len=20) :: name info=psb_success_ @@ -930,7 +932,6 @@ contains !...locals.... integer(psb_ipk_) :: info - if (allocated(desc%halo_index)) & & deallocate(desc%halo_index,stat=info) @@ -990,13 +991,14 @@ contains implicit none !....parameters... - type(psb_desc_type), intent(inout) :: desc - type(psb_desc_type), intent(inout) :: desc_out - integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout) :: desc + type(psb_desc_type), intent(inout) :: desc_out + integer(psb_ipk_), intent(out) :: info !locals - integer(psb_ipk_) :: np,me,ictxt, err_act - integer(psb_ipk_) :: debug_level, debug_unit + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name if (psb_get_errstatus() /= 0) return @@ -1010,7 +1012,7 @@ contains ! when desc is empty. ! if (desc%is_valid()) then - ictxt = psb_cd_get_context(desc) + ictxt = desc%get_ctxt() call psb_info(ictxt,me,np) if (info == psb_success_) & @@ -1083,8 +1085,9 @@ contains class(psb_desc_type), intent(inout) :: desc_out integer(psb_ipk_), intent(out) :: info !locals - integer(psb_ipk_) :: np,me,ictxt, err_act - integer(psb_ipk_) :: debug_level, debug_unit + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name debug_unit = psb_get_debug_unit() @@ -1097,7 +1100,7 @@ contains call desc_out%free(info) if ((info == psb_success_).and.desc%is_valid()) then - ictxt = desc%get_context() + ictxt = desc%get_ctxt() ! check on blacs grid call psb_info(ictxt, me, np) @@ -1162,13 +1165,14 @@ contains use psb_penv_mod use psb_realloc_mod Implicit None - integer(psb_ipk_), allocatable, intent(out) :: tmp(:) - integer(psb_ipk_), intent(in) :: data - Type(psb_desc_type), Intent(in), target :: desc - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), allocatable, intent(out) :: tmp(:) + integer(psb_ipk_), intent(in) :: data + Type(psb_desc_type), Intent(in), target :: desc + integer(psb_ipk_), intent(out) :: info ! .. Local Scalars .. - integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: incnt, outcnt, j, np, me, l_tmp,& & idx, proc, n_elem_send, n_elem_recv integer(psb_ipk_), pointer :: idxlist(:) integer(psb_ipk_) :: debug_level, debug_unit, err_act @@ -1180,7 +1184,7 @@ contains debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = psb_cd_get_context(desc) + ictxt = desc%get_context() call psb_info(ictxt, me, np) select case(data) @@ -1248,18 +1252,19 @@ contains use psb_penv_mod use psb_realloc_mod Implicit None - integer(psb_lpk_), allocatable, intent(out) :: tmp(:) - integer(psb_ipk_), intent(in) :: data - Type(psb_desc_type), Intent(in), target :: desc - integer(psb_ipk_), intent(out) :: info + integer(psb_lpk_), allocatable, intent(out) :: tmp(:) + integer(psb_ipk_), intent(in) :: data + type(psb_desc_type), Intent(in), target :: desc + integer(psb_ipk_), intent(out) :: info ! .. Local Scalars .. - integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: incnt, outcnt, j, np, me, l_tmp,& & idx, proc, n_elem_send, n_elem_recv integer(psb_ipk_), pointer :: idxlist(:) integer(psb_lpk_) :: gidx integer(psb_ipk_) :: debug_level, debug_unit, err_act - character(len=20) :: name + character(len=20) :: name name = 'psb_cd_get_recv_idx' info = psb_success_ @@ -1267,7 +1272,7 @@ contains debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = psb_cd_get_context(desc) + ictxt = desc%get_context() call psb_info(ictxt, me, np) select case(data) @@ -1338,7 +1343,7 @@ contains subroutine psb_cd_cnv(desc, mold) class(psb_desc_type), intent(inout), target :: desc - class(psb_i_base_vect_type), intent(in) :: mold + class(psb_i_base_vect_type), intent(in) :: mold call desc%v_halo_index%cnv(mold) call desc%v_ext_index%cnv(mold) @@ -1389,8 +1394,8 @@ contains integer(psb_ipk_), intent(in) :: idxin integer(psb_lpk_), intent(out) :: idxout integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned integer(psb_ipk_) :: err_act character(len=20) :: name='cd_l2g' @@ -1425,8 +1430,8 @@ contains class(psb_desc_type), intent(in) :: desc integer(psb_lpk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned integer(psb_ipk_) :: err_act character(len=20) :: name='cd_l2g' logical, parameter :: debug=.false. @@ -1460,8 +1465,8 @@ contains integer(psb_ipk_), intent(in) :: idxin(:) integer(psb_lpk_), intent(out) :: idxout(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned integer(psb_ipk_) :: err_act character(len=20) :: name='cd_l2g' logical, parameter :: debug=.false. @@ -1495,8 +1500,8 @@ contains class(psb_desc_type), intent(in) :: desc integer(psb_lpk_), intent(inout) :: idx integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned integer(psb_ipk_) :: err_act character(len=20) :: name='cd_g2l' logical, parameter :: debug=.false. @@ -1530,8 +1535,8 @@ contains integer(psb_lpk_), intent(in) :: idxin integer(psb_ipk_), intent(out) :: idxout integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned integer(psb_ipk_) :: err_act character(len=20) :: name='cd_g2l' @@ -1566,8 +1571,8 @@ contains class(psb_desc_type), intent(in) :: desc integer(psb_lpk_), intent(inout) :: idx(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned integer(psb_ipk_) :: err_act character(len=20) :: name='cd_g2l' logical, parameter :: debug=.false. @@ -1601,9 +1606,9 @@ contains integer(psb_lpk_), intent(in) :: idxin(:) integer(psb_ipk_), intent(out) :: idxout(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + integer(psb_ipk_) :: err_act character(len=20) :: name='cd_g2l' logical, parameter :: debug=.false. @@ -1637,9 +1642,9 @@ contains use psb_error_mod implicit none class(psb_desc_type), intent(inout) :: desc - integer(psb_lpk_), intent(inout) :: idx - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask + integer(psb_lpk_), intent(inout) :: idx + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask integer(psb_ipk_), intent(in), optional :: lidx integer(psb_ipk_) :: err_act character(len=20) :: name='cd_g2l_ins' @@ -1671,10 +1676,10 @@ contains use psb_error_mod implicit none class(psb_desc_type), intent(inout) :: desc - integer(psb_lpk_), intent(in) :: idxin - integer(psb_ipk_), intent(out) :: idxout - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask + integer(psb_lpk_), intent(in) :: idxin + integer(psb_ipk_), intent(out) :: idxout + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask integer(psb_ipk_), intent(in), optional :: lidx integer(psb_ipk_) :: err_act @@ -1709,9 +1714,9 @@ contains use psb_error_mod implicit none class(psb_desc_type), intent(inout) :: desc - integer(psb_lpk_), intent(inout) :: idx(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) + integer(psb_lpk_), intent(inout) :: idx(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) integer(psb_ipk_) :: err_act @@ -1745,10 +1750,10 @@ contains use psb_error_mod implicit none class(psb_desc_type), intent(inout) :: desc - integer(psb_lpk_), intent(in) :: idxin(:) - integer(psb_ipk_), intent(out) :: idxout(:) - integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: mask(:) + integer(psb_lpk_), intent(in) :: idxin(:) + integer(psb_ipk_), intent(out) :: idxout(:) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) integer(psb_ipk_) :: err_act @@ -1786,7 +1791,7 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_desc_type), intent(inout) :: desc integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act character(len=20) :: name='cd_fnd_owner' logical, parameter :: debug=.false. diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 6fc8123f..20dc28e4 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -805,8 +805,9 @@ contains logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned integer(psb_ipk_) :: i, nv, is - integer(psb_lpk_) :: tidx, ip, lip - integer(psb_ipk_) :: ictxt, iam, np + integer(psb_lpk_) :: tidx, ip, lip + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np logical :: owned_ info = 0 @@ -922,7 +923,8 @@ contains integer(psb_ipk_) :: i, nv, is, im integer(psb_lpk_) :: tidx, ip, lip - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np logical :: owned_ info = 0 @@ -1938,7 +1940,8 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_gen_block_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, iam, np, nv, ip, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np, nv, ip, i integer(psb_lpk_) :: tidx ictxt = idxmap%get_ctxt() @@ -1964,7 +1967,7 @@ contains use psb_error_mod implicit none class(psb_gen_block_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -1976,7 +1979,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt' info = -1 return end if @@ -2030,7 +2033,8 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nhal, i - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np logical :: debug=.false. info = 0 ictxt = idxmap%get_ctxt() @@ -2135,7 +2139,7 @@ contains implicit none class(psb_gen_block_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ictxt + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: k, nr, nc integer(psb_lpk_) :: lk integer(psb_ipk_), allocatable :: lidx(:) diff --git a/base/modules/desc/psb_glist_map_mod.f90 b/base/modules/desc/psb_glist_map_mod.f90 index 69169b17..aa721b7d 100644 --- a/base/modules/desc/psb_glist_map_mod.f90 +++ b/base/modules/desc/psb_glist_map_mod.f90 @@ -96,7 +96,7 @@ contains use psb_error_mod implicit none class(psb_glist_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -108,7 +108,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt' info = -1 return end if @@ -158,8 +158,9 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_glist_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: ictxt, iam, np - integer(psb_lpk_) :: nv, i, ngp + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np + integer(psb_lpk_) :: nv, i, ngp ictxt = idxmap%get_ctxt() call psb_info(ictxt,iam,np) diff --git a/base/modules/desc/psb_hash_map_mod.f90 b/base/modules/desc/psb_hash_map_mod.f90 index ae109d5a..04ed6e75 100644 --- a/base/modules/desc/psb_hash_map_mod.f90 +++ b/base/modules/desc/psb_hash_map_mod.f90 @@ -329,7 +329,8 @@ contains logical, intent(in), optional :: owned integer(psb_ipk_) :: i, lip, nrow, nrm, is integer(psb_lpk_) :: ncol, ip, tlip, mglob - integer(psb_mpk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np logical :: owned_ info = 0 @@ -541,8 +542,9 @@ contains integer(psb_ipk_) :: i, is, lip, nrow, ncol, & & err_act integer(psb_lpk_) :: mglob, ip, nxt, tlip - integer(psb_ipk_) :: ictxt, me, np - character(len=20) :: name,ch_err + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np + character(len=20) :: name,ch_err info = psb_success_ name = 'hash_g2l_ins' @@ -805,7 +807,7 @@ contains use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -819,7 +821,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt' info = -1 return end if @@ -878,7 +880,7 @@ contains use psb_error_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -890,7 +892,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt:' info = -1 return end if @@ -938,7 +940,7 @@ contains use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vlu(:), ntot integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info @@ -950,7 +952,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt:' info = -1 return end if @@ -996,10 +998,11 @@ contains class(psb_hash_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: ictxt, iam, np - integer(psb_ipk_) :: i, j, m, nl - integer(psb_ipk_) :: ih, nh, idx, nbits - integer(psb_lpk_) :: key, hsize, hmask + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: i, j, m, nl + integer(psb_ipk_) :: ih, nh, idx, nbits + integer(psb_lpk_) :: key, hsize, hmask character(len=20), parameter :: name='hash_map_init_vlu' info = 0 @@ -1007,7 +1010,7 @@ contains call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt:' info = -1 return end if @@ -1098,10 +1101,11 @@ contains use psb_sort_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: ictxt, iam, np - integer(psb_ipk_) :: nhal + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: nhal info = 0 ictxt = idxmap%get_ctxt() @@ -1534,7 +1538,8 @@ contains integer(psb_ipk_) :: err_act, nr,nc,k, nl integer(psb_lpk_) :: lk integer(psb_lpk_) :: ntot - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_ipk_), allocatable :: lidx(:), tadj(:), th_own(:) integer(psb_lpk_), allocatable :: gidx(:) character(len=20) :: name='hash_reinit' diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index dd72280b..a8752007 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -40,7 +40,7 @@ module psb_indx_map_mod use psb_const_mod use psb_desc_const_mod - + use psi_penv_mod, only : psb_ctxt_type ! !> \namespace psb_base_mod \class psb_indx_map !! \brief Object to handle the mapping between global and local indices. @@ -106,19 +106,19 @@ module psb_indx_map_mod !! type :: psb_indx_map !> State of the map - integer(psb_ipk_) :: state = psb_desc_null_ + integer(psb_ipk_) :: state = psb_desc_null_ !> Communication context - integer(psb_ipk_) :: ictxt = -1 + type(psb_ctxt_type) :: ictxt !> MPI communicator - integer(psb_mpk_) :: mpic = -1 + integer(psb_mpk_) :: mpic = -1 !> Number of global rows - integer(psb_lpk_) :: global_rows = -1 + integer(psb_lpk_) :: global_rows = -1 !> Number of global columns - integer(psb_lpk_) :: global_cols = -1 + integer(psb_lpk_) :: global_cols = -1 !> Number of local rows - integer(psb_ipk_) :: local_rows = -1 + integer(psb_ipk_) :: local_rows = -1 !> Number of local columns - integer(psb_ipk_) :: local_cols = -1 + integer(psb_ipk_) :: local_cols = -1 !> A pointer to the user-defined parts subroutine procedure(psb_parts), nopass, pointer :: parts => null() !> The global vector assigning indices to processes, temp copy @@ -335,18 +335,20 @@ module psb_indx_map_mod integer, parameter :: psi_symm_flag_inrv_ = 1 interface psi_symm_dep_list subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) - import :: psb_indx_map, psb_ipk_, psb_lpk_, psb_mpk_ + import :: psb_indx_map, psb_ipk_, psb_lpk_, psb_mpk_, & + & psb_ctxt_type implicit none integer(psb_mpk_), intent(inout) :: rvsz(0:) integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info end subroutine psi_symm_dep_list_inrv subroutine psi_symm_dep_list_norv(adj,ictxt,info) - import :: psb_indx_map, psb_ipk_, psb_lpk_, psb_mpk_ + import :: psb_indx_map, psb_ipk_, psb_lpk_, psb_mpk_, & + & psb_ctxt_type implicit none integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info end subroutine psi_symm_dep_list_norv end interface psi_symm_dep_list @@ -487,7 +489,7 @@ contains function base_get_ctxt(idxmap) result(val) implicit none class(psb_indx_map), intent(in) :: idxmap - integer(psb_ipk_) :: val + type(psb_ctxt_type) :: val val = idxmap%ictxt @@ -515,7 +517,7 @@ contains subroutine base_set_ctxt(idxmap,val) implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: val + type(psb_ctxt_type), intent(in) :: val idxmap%ictxt = val end subroutine base_set_ctxt @@ -1318,7 +1320,7 @@ contains ! almost nothing to be done here idxmap%state = -1 - idxmap%ictxt = -1 + if (allocated(idxmap%ictxt%ctxt)) deallocate(idxmap%ictxt%ctxt) idxmap%mpic = -1 idxmap%global_rows = -1 idxmap%global_cols = -1 @@ -1334,7 +1336,7 @@ contains class(psb_indx_map), intent(inout) :: idxmap idxmap%state = psb_desc_null_ - idxmap%ictxt = -1 + if (allocated(idxmap%ictxt%ctxt)) deallocate(idxmap%ictxt%ctxt) idxmap%mpic = -1 idxmap%global_rows = -1 idxmap%global_cols = -1 @@ -1348,7 +1350,7 @@ contains use psb_error_mod implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act diff --git a/base/modules/desc/psb_list_map_mod.f90 b/base/modules/desc/psb_list_map_mod.f90 index aab2a9d4..558b4bc2 100644 --- a/base/modules/desc/psb_list_map_mod.f90 +++ b/base/modules/desc/psb_list_map_mod.f90 @@ -1044,7 +1044,7 @@ contains use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -1055,7 +1055,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt:' info = -1 return end if @@ -1078,7 +1078,7 @@ contains use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -1088,7 +1088,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt:' info = -1 return end if @@ -1147,7 +1147,8 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nhal - integer(psb_mpk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/desc/psb_repl_map_mod.f90 b/base/modules/desc/psb_repl_map_mod.f90 index 7b29833b..815a1431 100644 --- a/base/modules/desc/psb_repl_map_mod.f90 +++ b/base/modules/desc/psb_repl_map_mod.f90 @@ -703,8 +703,9 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_repl_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: nv - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: nv + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np ictxt = idxmap%get_ctxt() call psb_info(ictxt,iam,np) @@ -726,7 +727,7 @@ contains implicit none class(psb_repl_map), intent(inout) :: idxmap integer(psb_lpk_), intent(in) :: nl - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info ! To be implemented integer(psb_ipk_) :: iam, np @@ -734,7 +735,7 @@ contains info = 0 call psb_info(ictxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:',ictxt + write(psb_err_unit,*) 'Invalid ictxt:' info = -1 return end if @@ -759,7 +760,8 @@ contains class(psb_repl_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_mpk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: iam, np info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/error.f90 b/base/modules/error.f90 index 89411836..4e20e708 100644 --- a/base/modules/error.f90 +++ b/base/modules/error.f90 @@ -36,7 +36,8 @@ subroutine FCpsb_errcomm(ictxt, err) use psb_const_mod use psb_error_mod - integer(psb_ipk_), intent(in) :: ictxt + use psi_penv_mod + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(inout):: err call psb_errcomm(ictxt, err) @@ -48,16 +49,14 @@ subroutine FCpsb_errpush(err_c, r_name, i_err) use psb_error_mod implicit none - integer(psb_ipk_), intent(in) :: err_c - character(len=20), intent(in) :: r_name + integer(psb_ipk_), intent(in) :: err_c + character(len=20), intent(in) :: r_name integer(psb_ipk_) :: i_err(5) call psb_errpush(err_c, r_name, i_err=i_err) end subroutine FCpsb_errpush - - subroutine FCpsb_serror() use psb_const_mod use psb_error_mod @@ -67,23 +66,18 @@ subroutine FCpsb_serror() end subroutine FCpsb_serror - - - - subroutine FCpsb_perror(ictxt) use psb_const_mod use psb_error_mod + use psi_penv_mod implicit none - integer(psb_ipk_), intent(in) :: ictxt - + type(psb_ctxt_type), intent(in) :: ictxt + call psb_error(ictxt) end subroutine FCpsb_perror - - function FCpsb_get_errstatus() use psb_const_mod use psb_error_mod @@ -95,7 +89,6 @@ function FCpsb_get_errstatus() end function FCpsb_get_errstatus - subroutine FCpsb_get_errverbosity(v) use psb_const_mod use psb_error_mod @@ -107,8 +100,6 @@ subroutine FCpsb_get_errverbosity(v) end subroutine FCpsb_get_errverbosity - - subroutine FCpsb_set_errverbosity(v) use psb_const_mod use psb_error_mod @@ -120,8 +111,6 @@ subroutine FCpsb_set_errverbosity(v) end subroutine FCpsb_set_errverbosity - - subroutine FCpsb_erractionsave(err_act) use psb_const_mod use psb_error_mod @@ -133,7 +122,6 @@ subroutine FCpsb_erractionsave(err_act) end subroutine FCpsb_erractionsave - subroutine FCpsb_get_erraction(err_act) use psb_const_mod use psb_error_mod @@ -143,8 +131,6 @@ subroutine FCpsb_get_erraction(err_act) call psb_get_erraction(err_act) end subroutine FCpsb_get_erraction - - subroutine FCpsb_erractionrestore(err_act) use psb_const_mod use psb_error_mod @@ -155,9 +141,3 @@ subroutine FCpsb_erractionrestore(err_act) call psb_erractionrestore(err_act) end subroutine FCpsb_erractionrestore - - - - - - diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index 4ddef9e0..b9555a97 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -94,11 +94,6 @@ module psi_penv_mod integer(psb_mpk_), private, parameter:: psb_int4_type = psb_int2_type + 1 integer(psb_mpk_), private, parameter:: psb_long_type = psb_int4_type + 1 - - type psb_ctxt_type - integer(psb_mpk_), allocatable :: ctxt - end type psb_ctxt_type - type psb_buffer_node integer(psb_mpk_) :: request type(psb_ctxt_type) :: icontxt @@ -196,19 +191,6 @@ module psi_penv_mod contains - - function psb_cmp_ctxt(ctxt1, ctxt2) result(res) - type(psb_ctxt_type), intent(in) :: ctxt1, ctxt2 - logical :: res - - res = .false. - if (.not.allocated(ctxt1%ctxt).and.(.not.allocated(ctxt2%ctxt))) & - & res = .true. - if (allocated(ctxt1%ctxt).and.allocated(ctxt2%ctxt)) & - & res = (ctxt1%ctxt == ctxt2%ctxt) - - end function psb_cmp_ctxt - subroutine psb_init_queue(mesg_queue,info) implicit none type(psb_buffer_queue), intent(inout) :: mesg_queue diff --git a/base/modules/psb_cbind_const_mod.F90 b/base/modules/psb_cbind_const_mod.F90 index 2b4bdf69..a20258ac 100644 --- a/base/modules/psb_cbind_const_mod.F90 +++ b/base/modules/psb_cbind_const_mod.F90 @@ -32,6 +32,7 @@ module psb_cbind_const_mod use iso_c_binding + use psb_const_mod integer, parameter :: psb_c_mpk_ = c_int32_t #if defined(IPK4) && defined(LPK4) @@ -48,5 +49,4 @@ module psb_cbind_const_mod integer, parameter :: psb_c_lpk_ = -1 #endif integer, parameter :: psb_c_epk_ = c_int64_t - end module psb_cbind_const_mod diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index 26a100a7..c8ed484a 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -315,4 +315,23 @@ module psb_const_mod integer(psb_ipk_), parameter, public :: psb_err_invalid_preci_=5003 integer(psb_ipk_), parameter, public :: psb_err_invalid_preca_=5004 + + type psb_ctxt_type + integer(psb_mpk_), allocatable :: ctxt + end type psb_ctxt_type + +contains + + function psb_cmp_ctxt(ctxt1, ctxt2) result(res) + type(psb_ctxt_type), intent(in) :: ctxt1, ctxt2 + logical :: res + + res = .false. + if (.not.allocated(ctxt1%ctxt).and.(.not.allocated(ctxt2%ctxt))) & + & res = .true. + if (allocated(ctxt1%ctxt).and.allocated(ctxt2%ctxt)) & + & res = (ctxt1%ctxt == ctxt2%ctxt) + + end function psb_cmp_ctxt + end module psb_const_mod diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index 1073f24d..e8f58dd8 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -2,8 +2,8 @@ subroutine psb_errcomm_i(ictxt, err) use psb_error_mod, psb_protect_name => psb_errcomm use psb_penv_mod - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout):: err + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(inout) :: err if (psb_get_global_checks()) call psb_amx(ictxt, err) @@ -14,8 +14,8 @@ end subroutine psb_errcomm_i subroutine psb_errcomm_m(ictxt, err) use psb_error_mod, psb_protect_name => psb_errcomm use psb_penv_mod - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout):: err + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(inout) :: err if (psb_get_global_checks()) call psb_amx(ictxt, err) @@ -41,8 +41,8 @@ subroutine psb_par_error_handler(ictxt,err_act) use psb_error_mod, psb_protect_name => psb_par_error_handler use psb_penv_mod implicit none - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(in) :: err_act + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: err_act call psb_erractionrestore(err_act) @@ -58,7 +58,7 @@ end subroutine psb_par_error_handler subroutine psb_par_error_print_stack(ictxt) use psb_error_mod, psb_protect_name => psb_par_error_print_stack use psb_penv_mod - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt call psb_error(ictxt, abrt=.false.) @@ -79,8 +79,8 @@ subroutine psb_serror() use psb_error_mod implicit none integer(psb_ipk_) :: err_c - character(len=20) :: r_name - character(len=40) :: a_e_d + character(len=20) :: r_name + character(len=40) :: a_e_d integer(psb_epk_) :: e_e_d(5) if (psb_errstatus_fatal()) then @@ -116,20 +116,19 @@ subroutine psb_perror(ictxt,abrt) use psb_error_mod use psb_penv_mod implicit none - integer(psb_ipk_), intent(in) :: ictxt - logical, intent(in), optional :: abrt - - integer(psb_ipk_) :: err_c - character(len=20) :: r_name - character(len=40) :: a_e_d - integer(psb_epk_) :: e_e_d(5) - integer(psb_mpk_) :: iictxt, iam, np + type(psb_ctxt_type), intent(in) :: ictxt + logical, intent(in), optional :: abrt + + integer(psb_ipk_) :: err_c + character(len=20) :: r_name + character(len=40) :: a_e_d + integer(psb_epk_) :: e_e_d(5) + integer(psb_mpk_) :: iam, np logical :: abrt_ abrt_=.true. if (present(abrt)) abrt_=abrt - iictxt = ictxt - call psb_info(iictxt,iam,np) + call psb_info(ictxt,iam,np) if (psb_errstatus_fatal()) then if (psb_get_errverbosity() > 1) then @@ -144,7 +143,7 @@ subroutine psb_perror(ictxt,abrt) flush(psb_err_unit) #endif - if (abrt_) call psb_abort(iictxt,-1) + if (abrt_) call psb_abort(ictxt,-1) else @@ -157,7 +156,7 @@ subroutine psb_perror(ictxt,abrt) flush(psb_err_unit) #endif - if (abrt_) call psb_abort(iictxt,-1) + if (abrt_) call psb_abort(ictxt,-1) end if end if diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index df76dd20..75988639 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -31,7 +31,7 @@ ! module psb_error_mod use psb_const_mod - + integer(psb_ipk_), parameter, public :: psb_act_ret_=0 integer(psb_ipk_), parameter, public :: psb_act_print_=1 integer(psb_ipk_), parameter, public :: psb_act_abort_=2 @@ -72,8 +72,8 @@ module psb_error_mod integer(psb_ipk_), intent(inout) :: err_act end subroutine psb_ser_error_handler subroutine psb_par_error_handler(ictxt,err_act) - import :: psb_ipk_,psb_mpk_ - integer(psb_ipk_), intent(in) :: ictxt + import :: psb_ipk_,psb_mpk_, psb_ctxt_type + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: err_act end subroutine psb_par_error_handler end interface @@ -82,8 +82,8 @@ module psb_error_mod subroutine psb_serror() end subroutine psb_serror subroutine psb_perror(ictxt,abrt) - import :: psb_ipk_ - integer(psb_ipk_), intent(in) :: ictxt + import :: psb_ipk_, psb_ctxt_type + type(psb_ctxt_type), intent(in) :: ictxt logical, intent(in), optional :: abrt end subroutine psb_perror end interface @@ -91,8 +91,8 @@ module psb_error_mod interface psb_error_print_stack subroutine psb_par_error_print_stack(ictxt) - import :: psb_ipk_ - integer(psb_ipk_), intent(in) :: ictxt + import :: psb_ipk_, psb_ctxt_type + type(psb_ctxt_type), intent(in) :: ictxt end subroutine psb_par_error_print_stack subroutine psb_ser_error_print_stack() end subroutine psb_ser_error_print_stack @@ -101,15 +101,15 @@ module psb_error_mod interface psb_errcomm #if defined(IPK8) subroutine psb_errcomm_m(ictxt, err) - import :: psb_ipk_, psb_mpk_ - integer(psb_mpk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout):: err + import :: psb_ipk_, psb_mpk_, psb_ctxt_type + type(pxb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(inout) :: err end subroutine psb_errcomm_m #endif subroutine psb_errcomm_i(ictxt, err) - import :: psb_ipk_ - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(inout):: err + import :: psb_ipk_, psb_ctxt_type + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(inout) :: err end subroutine psb_errcomm_i end interface psb_errcomm diff --git a/base/modules/psb_timers_mod.f90 b/base/modules/psb_timers_mod.f90 index 18107d6d..69428558 100644 --- a/base/modules/psb_timers_mod.f90 +++ b/base/modules/psb_timers_mod.f90 @@ -97,7 +97,7 @@ contains subroutine psb_print_timers(ictxt, idx, proc, global, iout) implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in), optional :: idx, proc, iout logical, optional :: global ! @@ -280,7 +280,7 @@ contains use psb_error_mod implicit none ! ...Subroutine Arguments - integer(psb_ipk_),Intent(in) :: len + integer(psb_ipk_),Intent(in) :: len type(psb_string_item),allocatable, intent(inout) :: rrax(:) integer(psb_ipk_) :: info integer(psb_ipk_), optional, intent(in) :: lb diff --git a/base/modules/psi_i_mod.F90 b/base/modules/psi_i_mod.F90 index 5eebad41..04d74be6 100644 --- a/base/modules/psi_i_mod.F90 +++ b/base/modules/psi_i_mod.F90 @@ -38,17 +38,6 @@ module psi_i_mod use psb_i_base_multivect_mod, only : psb_i_base_multivect_type use psi_i_comm_v_mod - interface psi_compute_size - subroutine psi_i_compute_size(desc_data,& - & index_in, dl_lda, info) - import - implicit none - integer(psb_ipk_) :: info - integer(psb_ipk_) :: dl_lda - integer(psb_ipk_) :: desc_data(:), index_in(:) - end subroutine psi_i_compute_size - end interface - interface psi_crea_bnd_elem subroutine psi_i_crea_bnd_elem(bndel,desc_a,info) import @@ -100,7 +89,7 @@ module psi_i_mod implicit none integer(psb_ipk_), intent(in) :: c_dep_list(:), dl_ptr(0:) integer(psb_ipk_), intent(inout) :: l_dep_list(0:) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: info end subroutine psi_i_csr_sort_dl end interface @@ -110,24 +99,25 @@ module psi_i_mod & length_dl,dl_lda,mode,info) import implicit none - logical, intent(in) :: is_bld, is_upd - integer(psb_ipk_), intent(in) :: ictxt, mode - integer(psb_ipk_), intent(out) :: dl_lda - integer(psb_ipk_), intent(in) :: desc_str(*) + logical, intent(in) :: is_bld, is_upd + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_), intent(in) :: mode + integer(psb_ipk_), intent(out) :: dl_lda + integer(psb_ipk_), intent(in) :: desc_str(*) integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:), length_dl(:) integer(psb_ipk_), intent(out) :: info end subroutine psi_i_extract_dep_list end interface interface psi_bld_glb_dep_list - subroutine psi_i_bld_glb_dep_list(ictxt,loc_dl,length_dl,dep_list,dl_lda,info) - import - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: dl_lda - integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) - integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) - integer(psb_ipk_), intent(out) :: info - end subroutine psi_i_bld_glb_dep_list +!!$ subroutine psi_i_bld_glb_dep_list(ictxt,loc_dl,length_dl,dep_list,dl_lda,info) +!!$ import +!!$ type(psb_ctxt_type), intent(in) :: ictxt +!!$ integer(psb_ipk_), intent(out) :: dl_lda +!!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) +!!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psi_i_bld_glb_dep_list subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) import integer(psb_ipk_), intent(in) :: ictxt @@ -141,7 +131,7 @@ module psi_i_mod subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) import logical, intent(in) :: is_bld, is_upd - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: desc_str(:) integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:) integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/tools/psb_cd_tools_mod.F90 b/base/modules/tools/psb_cd_tools_mod.F90 index 3a67d829..e7efae9c 100644 --- a/base/modules/tools/psb_cd_tools_mod.F90 +++ b/base/modules/tools/psb_cd_tools_mod.F90 @@ -192,11 +192,12 @@ module psb_cd_tools_mod subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,& & globalcheck,lidx,usehash) - import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts + import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts, psb_ctxt_type implicit None procedure(psb_parts) :: parts integer(psb_lpk_), intent(in) :: mg,ng, vl(:) - integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_), intent(in) :: vg(:), lidx(:),nl integer(psb_ipk_), intent(in) :: flag logical, intent(in) :: repl, globalcheck, usehash integer(psb_ipk_), intent(out) :: info diff --git a/base/psblas/psb_cabs_vect.f90 b/base/psblas/psb_cabs_vect.f90 index 46e74635..f70f9a46 100644 --- a/base/psblas/psb_cabs_vect.f90 +++ b/base/psblas/psb_cabs_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_cabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_camax.f90 b/base/psblas/psb_camax.f90 index 21569613..2347eb80 100644 --- a/base/psblas/psb_camax.f90 +++ b/base/psblas/psb_camax.f90 @@ -57,7 +57,8 @@ function psb_camax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -185,7 +186,8 @@ function psb_camaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -280,7 +282,8 @@ function psb_camax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -409,7 +412,8 @@ subroutine psb_camaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -532,7 +536,8 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_casum.f90 b/base/psblas/psb_casum.f90 index a0bf5262..3edfb637 100644 --- a/base/psblas/psb_casum.f90 +++ b/base/psblas/psb_casum.f90 @@ -57,7 +57,8 @@ function psb_casum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -160,7 +161,8 @@ function psb_casum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -297,7 +299,8 @@ function psb_casumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -428,7 +431,8 @@ subroutine psb_casumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_caxpby.f90 b/base/psblas/psb_caxpby.f90 index 6518e730..b37f9a6d 100644 --- a/base/psblas/psb_caxpby.f90 +++ b/base/psblas/psb_caxpby.f90 @@ -59,7 +59,8 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -192,7 +193,8 @@ subroutine psb_caxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -308,7 +310,8 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) complex(psb_spk_), intent(inout) :: y(:,:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -456,7 +459,8 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info) complex(psb_spk_), intent(inout) :: y(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -578,7 +582,8 @@ subroutine psb_caxpbyvout(alpha, x, beta,y, z, desc_a,info) complex(psb_spk_), intent(inout) :: z(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -673,7 +678,8 @@ subroutine psb_caddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_ccmp_vect.f90 b/base/psblas/psb_ccmp_vect.f90 index 367f193b..f8442d97 100644 --- a/base/psblas/psb_ccmp_vect.f90 +++ b/base/psblas/psb_ccmp_vect.f90 @@ -41,7 +41,8 @@ subroutine psb_ccmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -115,7 +116,8 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit @@ -169,7 +171,8 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/psblas/psb_cdiv_vect.f90 b/base/psblas/psb_cdiv_vect.f90 index 3e709da4..5149d1e2 100644 --- a/base/psblas/psb_cdiv_vect.f90 +++ b/base/psblas/psb_cdiv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_cdiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -114,7 +115,8 @@ subroutine psb_cdiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -201,7 +203,8 @@ subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -276,7 +279,8 @@ subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_cdot.f90 b/base/psblas/psb_cdot.f90 index 5432eb32..6d012e77 100644 --- a/base/psblas/psb_cdot.f90 +++ b/base/psblas/psb_cdot.f90 @@ -64,7 +64,8 @@ function psb_cdot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -187,7 +188,8 @@ function psb_cdot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m complex(psb_spk_) :: cdotc @@ -338,7 +340,8 @@ function psb_cdotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -474,7 +477,8 @@ subroutine psb_cdotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -608,7 +612,8 @@ subroutine psb_cmdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_cgetmatinfo.f90 b/base/psblas/psb_cgetmatinfo.f90 index 9e406c15..c5e59862 100644 --- a/base/psblas/psb_cgetmatinfo.f90 +++ b/base/psblas/psb_cgetmatinfo.f90 @@ -47,7 +47,8 @@ function psb_cget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz character(len=20) :: name, ch_err diff --git a/base/psblas/psb_cinv_vect.f90 b/base/psblas/psb_cinv_vect.f90 index 27f04681..6dea51b3 100644 --- a/base/psblas/psb_cinv_vect.f90 +++ b/base/psblas/psb_cinv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_cinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -115,7 +116,8 @@ subroutine psb_cinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_cmlt_vect.f90 b/base/psblas/psb_cmlt_vect.f90 index e2b09270..2e7743ff 100644 --- a/base/psblas/psb_cmlt_vect.f90 +++ b/base/psblas/psb_cmlt_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_cmlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -120,7 +121,8 @@ subroutine psb_cmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_cnrm2.f90 b/base/psblas/psb_cnrm2.f90 index d357c951..e5eac8e6 100644 --- a/base/psblas/psb_cnrm2.f90 +++ b/base/psblas/psb_cnrm2.f90 @@ -60,7 +60,8 @@ function psb_cnrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -195,7 +196,8 @@ function psb_cnrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m real(psb_spk_) :: scnrm2, dd @@ -291,7 +293,8 @@ function psb_cnrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -398,7 +401,8 @@ function psb_cnrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -508,7 +512,8 @@ function psb_cnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -645,7 +650,8 @@ subroutine psb_cnrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_cnrmi.f90 b/base/psblas/psb_cnrmi.f90 index 0abece53..1303e5d8 100644 --- a/base/psblas/psb_cnrmi.f90 +++ b/base/psblas/psb_cnrmi.f90 @@ -53,7 +53,8 @@ function psb_cnrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index 5a059647..b35aa4af 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -71,7 +71,8 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -309,7 +310,8 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik @@ -656,7 +658,8 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_cspnrm1.f90 b/base/psblas/psb_cspnrm1.f90 index c49fdcc1..22e5f8a4 100644 --- a/base/psblas/psb_cspnrm1.f90 +++ b/base/psblas/psb_cspnrm1.f90 @@ -53,7 +53,8 @@ function psb_cspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, nr,nc,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 3fc8138c..0c0b4b4b 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -84,7 +84,8 @@ subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -289,7 +290,8 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -533,7 +535,8 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_dabs_vect.f90 b/base/psblas/psb_dabs_vect.f90 index 78f2b75c..e749adf1 100644 --- a/base/psblas/psb_dabs_vect.f90 +++ b/base/psblas/psb_dabs_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_dabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 index ea3581d4..30fc025f 100644 --- a/base/psblas/psb_damax.f90 +++ b/base/psblas/psb_damax.f90 @@ -57,7 +57,8 @@ function psb_damax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -185,7 +186,8 @@ function psb_damaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -280,7 +282,8 @@ function psb_damax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -409,7 +412,8 @@ subroutine psb_damaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -532,7 +536,8 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -631,7 +636,8 @@ function psb_dmin_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 index 5de367f7..f3e02141 100644 --- a/base/psblas/psb_dasum.f90 +++ b/base/psblas/psb_dasum.f90 @@ -57,7 +57,8 @@ function psb_dasum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -160,7 +161,8 @@ function psb_dasum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -297,7 +299,8 @@ function psb_dasumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -428,7 +431,8 @@ subroutine psb_dasumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index 550711e4..5206bec3 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -59,7 +59,8 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -192,7 +193,8 @@ subroutine psb_daxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -308,7 +310,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) real(psb_dpk_), intent(inout) :: y(:,:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -456,7 +459,8 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) real(psb_dpk_), intent(inout) :: y(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -578,7 +582,8 @@ subroutine psb_daxpbyvout(alpha, x, beta,y, z, desc_a,info) real(psb_dpk_), intent(inout) :: z(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -673,7 +678,8 @@ subroutine psb_daddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_dcmp_vect.f90 b/base/psblas/psb_dcmp_vect.f90 index 084feeda..eb426a10 100644 --- a/base/psblas/psb_dcmp_vect.f90 +++ b/base/psblas/psb_dcmp_vect.f90 @@ -41,7 +41,8 @@ subroutine psb_dcmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -148,7 +149,8 @@ subroutine psb_dmask_vect(c,x,m,t,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, mm character(len=20) :: name, ch_err @@ -237,7 +239,8 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit @@ -291,7 +294,8 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/psblas/psb_ddiv_vect.f90 b/base/psblas/psb_ddiv_vect.f90 index d5a85913..ba57776b 100644 --- a/base/psblas/psb_ddiv_vect.f90 +++ b/base/psblas/psb_ddiv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_ddiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -114,7 +115,8 @@ subroutine psb_ddiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -201,7 +203,8 @@ subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -276,7 +279,8 @@ subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -369,7 +373,8 @@ function psb_dminquotient_vect(x,y,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index ba1d9619..65474433 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -64,7 +64,8 @@ function psb_ddot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -187,7 +188,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m real(psb_dpk_) :: ddot @@ -338,7 +340,8 @@ function psb_ddotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -474,7 +477,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -608,7 +612,8 @@ subroutine psb_dmdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_dgetmatinfo.f90 b/base/psblas/psb_dgetmatinfo.f90 index 2caf8ed4..f27acbd3 100644 --- a/base/psblas/psb_dgetmatinfo.f90 +++ b/base/psblas/psb_dgetmatinfo.f90 @@ -47,7 +47,8 @@ function psb_dget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz character(len=20) :: name, ch_err diff --git a/base/psblas/psb_dinv_vect.f90 b/base/psblas/psb_dinv_vect.f90 index 89b25e38..a4ef6ecc 100644 --- a/base/psblas/psb_dinv_vect.f90 +++ b/base/psblas/psb_dinv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_dinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -115,7 +116,8 @@ subroutine psb_dinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_dmlt_vect.f90 b/base/psblas/psb_dmlt_vect.f90 index ac45802f..72754d11 100644 --- a/base/psblas/psb_dmlt_vect.f90 +++ b/base/psblas/psb_dmlt_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_dmlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -120,7 +121,8 @@ subroutine psb_dmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 index 16b18d91..2afd6982 100644 --- a/base/psblas/psb_dnrm2.f90 +++ b/base/psblas/psb_dnrm2.f90 @@ -60,7 +60,8 @@ function psb_dnrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -195,7 +196,8 @@ function psb_dnrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m real(psb_dpk_) :: dnrm2, dd @@ -291,7 +293,8 @@ function psb_dnrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -398,7 +401,8 @@ function psb_dnrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -508,7 +512,8 @@ function psb_dnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -645,7 +650,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index a6a97751..2d67fb7c 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -53,7 +53,8 @@ function psb_dnrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index 1fdf6171..ab733692 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -71,7 +71,8 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -309,7 +310,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik @@ -656,7 +658,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_dspnrm1.f90 b/base/psblas/psb_dspnrm1.f90 index 9d367615..1e118a35 100644 --- a/base/psblas/psb_dspnrm1.f90 +++ b/base/psblas/psb_dspnrm1.f90 @@ -53,7 +53,8 @@ function psb_dspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, nr,nc,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index f1a019ad..2c5d4807 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -84,7 +84,8 @@ subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -289,7 +290,8 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -533,7 +535,8 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_sabs_vect.f90 b/base/psblas/psb_sabs_vect.f90 index 1d4897a9..9d88b526 100644 --- a/base/psblas/psb_sabs_vect.f90 +++ b/base/psblas/psb_sabs_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_sabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_samax.f90 b/base/psblas/psb_samax.f90 index 30b22fd8..08d921d3 100644 --- a/base/psblas/psb_samax.f90 +++ b/base/psblas/psb_samax.f90 @@ -57,7 +57,8 @@ function psb_samax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -185,7 +186,8 @@ function psb_samaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -280,7 +282,8 @@ function psb_samax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -409,7 +412,8 @@ subroutine psb_samaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -532,7 +536,8 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -631,7 +636,8 @@ function psb_smin_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_sasum.f90 b/base/psblas/psb_sasum.f90 index a61f1851..406b8e8e 100644 --- a/base/psblas/psb_sasum.f90 +++ b/base/psblas/psb_sasum.f90 @@ -57,7 +57,8 @@ function psb_sasum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -160,7 +161,8 @@ function psb_sasum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -297,7 +299,8 @@ function psb_sasumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -428,7 +431,8 @@ subroutine psb_sasumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_saxpby.f90 b/base/psblas/psb_saxpby.f90 index b264c3b0..a04b622e 100644 --- a/base/psblas/psb_saxpby.f90 +++ b/base/psblas/psb_saxpby.f90 @@ -59,7 +59,8 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -192,7 +193,8 @@ subroutine psb_saxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -308,7 +310,8 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) real(psb_spk_), intent(inout) :: y(:,:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -456,7 +459,8 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info) real(psb_spk_), intent(inout) :: y(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -578,7 +582,8 @@ subroutine psb_saxpbyvout(alpha, x, beta,y, z, desc_a,info) real(psb_spk_), intent(inout) :: z(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -673,7 +678,8 @@ subroutine psb_saddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_scmp_vect.f90 b/base/psblas/psb_scmp_vect.f90 index c67cda7c..7a32dd6e 100644 --- a/base/psblas/psb_scmp_vect.f90 +++ b/base/psblas/psb_scmp_vect.f90 @@ -41,7 +41,8 @@ subroutine psb_scmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -148,7 +149,8 @@ subroutine psb_smask_vect(c,x,m,t,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, mm character(len=20) :: name, ch_err @@ -237,7 +239,8 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit @@ -291,7 +294,8 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/psblas/psb_sdiv_vect.f90 b/base/psblas/psb_sdiv_vect.f90 index 2fba3e73..1857200c 100644 --- a/base/psblas/psb_sdiv_vect.f90 +++ b/base/psblas/psb_sdiv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_sdiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -114,7 +115,8 @@ subroutine psb_sdiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -201,7 +203,8 @@ subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -276,7 +279,8 @@ subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -369,7 +373,8 @@ function psb_sminquotient_vect(x,y,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_sdot.f90 b/base/psblas/psb_sdot.f90 index cce9e15c..dbc1a17e 100644 --- a/base/psblas/psb_sdot.f90 +++ b/base/psblas/psb_sdot.f90 @@ -64,7 +64,8 @@ function psb_sdot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -187,7 +188,8 @@ function psb_sdot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m real(psb_spk_) :: sdot @@ -338,7 +340,8 @@ function psb_sdotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -474,7 +477,8 @@ subroutine psb_sdotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -608,7 +612,8 @@ subroutine psb_smdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_sgetmatinfo.f90 b/base/psblas/psb_sgetmatinfo.f90 index 8888d4db..7e10aee1 100644 --- a/base/psblas/psb_sgetmatinfo.f90 +++ b/base/psblas/psb_sgetmatinfo.f90 @@ -47,7 +47,8 @@ function psb_sget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz character(len=20) :: name, ch_err diff --git a/base/psblas/psb_sinv_vect.f90 b/base/psblas/psb_sinv_vect.f90 index 5666a821..c3e3e891 100644 --- a/base/psblas/psb_sinv_vect.f90 +++ b/base/psblas/psb_sinv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_sinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -115,7 +116,8 @@ subroutine psb_sinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_smlt_vect.f90 b/base/psblas/psb_smlt_vect.f90 index 8f1623d9..30722022 100644 --- a/base/psblas/psb_smlt_vect.f90 +++ b/base/psblas/psb_smlt_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_smlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -120,7 +121,8 @@ subroutine psb_smlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_snrm2.f90 b/base/psblas/psb_snrm2.f90 index ab9c56ca..fbf1bdd5 100644 --- a/base/psblas/psb_snrm2.f90 +++ b/base/psblas/psb_snrm2.f90 @@ -60,7 +60,8 @@ function psb_snrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -195,7 +196,8 @@ function psb_snrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m real(psb_spk_) :: snrm2, dd @@ -291,7 +293,8 @@ function psb_snrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -398,7 +401,8 @@ function psb_snrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -508,7 +512,8 @@ function psb_snrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -645,7 +650,8 @@ subroutine psb_snrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_snrmi.f90 b/base/psblas/psb_snrmi.f90 index 9fc41073..2234474c 100644 --- a/base/psblas/psb_snrmi.f90 +++ b/base/psblas/psb_snrmi.f90 @@ -53,7 +53,8 @@ function psb_snrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index 56b881b8..769450e7 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -71,7 +71,8 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -309,7 +310,8 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik @@ -656,7 +658,8 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_sspnrm1.f90 b/base/psblas/psb_sspnrm1.f90 index 9d2afeb8..71b540bf 100644 --- a/base/psblas/psb_sspnrm1.f90 +++ b/base/psblas/psb_sspnrm1.f90 @@ -53,7 +53,8 @@ function psb_sspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, nr,nc,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index 1cbbd6d2..d9371624 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -84,7 +84,8 @@ subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -289,7 +290,8 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -533,7 +535,8 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_zabs_vect.f90 b/base/psblas/psb_zabs_vect.f90 index 86ac6bfb..fe1a1f7f 100644 --- a/base/psblas/psb_zabs_vect.f90 +++ b/base/psblas/psb_zabs_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_zabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 index 8fd10043..035697da 100644 --- a/base/psblas/psb_zamax.f90 +++ b/base/psblas/psb_zamax.f90 @@ -57,7 +57,8 @@ function psb_zamax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -185,7 +186,8 @@ function psb_zamaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -280,7 +282,8 @@ function psb_zamax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -409,7 +412,8 @@ subroutine psb_zamaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -532,7 +536,8 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 index 9b6fddd7..6ede26d8 100644 --- a/base/psblas/psb_zasum.f90 +++ b/base/psblas/psb_zasum.f90 @@ -57,7 +57,8 @@ function psb_zasum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -160,7 +161,8 @@ function psb_zasum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -297,7 +299,8 @@ function psb_zasumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -428,7 +431,8 @@ subroutine psb_zasumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index c0cf79fd..ce96a080 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -59,7 +59,8 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -192,7 +193,8 @@ subroutine psb_zaxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -308,7 +310,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) complex(psb_dpk_), intent(inout) :: y(:,:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -456,7 +459,8 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) complex(psb_dpk_), intent(inout) :: y(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -578,7 +582,8 @@ subroutine psb_zaxpbyvout(alpha, x, beta,y, z, desc_a,info) complex(psb_dpk_), intent(inout) :: z(:) ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -673,7 +678,8 @@ subroutine psb_zaddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_zcmp_vect.f90 b/base/psblas/psb_zcmp_vect.f90 index d0184d09..2e6d65d1 100644 --- a/base/psblas/psb_zcmp_vect.f90 +++ b/base/psblas/psb_zcmp_vect.f90 @@ -41,7 +41,8 @@ subroutine psb_zcmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -115,7 +116,8 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit @@ -169,7 +171,8 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/psblas/psb_zdiv_vect.f90 b/base/psblas/psb_zdiv_vect.f90 index f07f5d00..f6ef22ec 100644 --- a/base/psblas/psb_zdiv_vect.f90 +++ b/base/psblas/psb_zdiv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_zdiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -114,7 +115,8 @@ subroutine psb_zdiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err @@ -201,7 +203,8 @@ subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -276,7 +279,8 @@ subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index ad21b1d8..12a82696 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -64,7 +64,8 @@ function psb_zdot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -187,7 +188,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m complex(psb_dpk_) :: zdotc @@ -338,7 +340,8 @@ function psb_zdotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -474,7 +477,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m logical :: global_ @@ -608,7 +612,8 @@ subroutine psb_zmdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, idx, ndm,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_zgetmatinfo.f90 b/base/psblas/psb_zgetmatinfo.f90 index 7d18418b..c157613f 100644 --- a/base/psblas/psb_zgetmatinfo.f90 +++ b/base/psblas/psb_zgetmatinfo.f90 @@ -47,7 +47,8 @@ function psb_zget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz character(len=20) :: name, ch_err diff --git a/base/psblas/psb_zinv_vect.f90 b/base/psblas/psb_zinv_vect.f90 index bb37ee69..938ec42e 100644 --- a/base/psblas/psb_zinv_vect.f90 +++ b/base/psblas/psb_zinv_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_zinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -115,7 +116,8 @@ subroutine psb_zinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_zmlt_vect.f90 b/base/psblas/psb_zmlt_vect.f90 index 598a12a7..e35a3b5a 100644 --- a/base/psblas/psb_zmlt_vect.f90 +++ b/base/psblas/psb_zmlt_vect.f90 @@ -40,7 +40,8 @@ subroutine psb_zmlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -120,7 +121,8 @@ subroutine psb_zmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m character(len=20) :: name, ch_err diff --git a/base/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 index bfa29d18..2a616a8c 100644 --- a/base/psblas/psb_znrm2.f90 +++ b/base/psblas/psb_znrm2.f90 @@ -60,7 +60,8 @@ function psb_znrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m logical :: global_ @@ -195,7 +196,8 @@ function psb_znrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m real(psb_dpk_) :: dznrm2, dd @@ -291,7 +293,8 @@ function psb_znrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -398,7 +401,8 @@ function psb_znrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -508,7 +512,8 @@ function psb_znrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ @@ -645,7 +650,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m logical :: global_ diff --git a/base/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 index 19b071e4..d49ae9cd 100644 --- a/base/psblas/psb_znrmi.f90 +++ b/base/psblas/psb_znrmi.f90 @@ -53,7 +53,8 @@ function psb_znrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index add3205b..8eeefe37 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -71,7 +71,8 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -309,7 +310,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik @@ -656,7 +658,8 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/psblas/psb_zspnrm1.f90 b/base/psblas/psb_zspnrm1.f90 index 7bc5fa15..578c8329 100644 --- a/base/psblas/psb_zspnrm1.f90 +++ b/base/psblas/psb_zspnrm1.f90 @@ -53,7 +53,8 @@ function psb_zspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - integer(psb_ipk_) :: ictxt, np, me, nr,nc,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja logical :: global_ diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index 63cbe783..6daca718 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -84,7 +84,8 @@ subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -289,7 +290,8 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - integer(psb_ipk_) :: ictxt, np, me,& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -533,7 +535,8 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - integer(psb_ipk_) :: ictxt, np, me, & + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja, lik, jx, jy diff --git a/base/tools/psb_c_glob_transpose.F90 b/base/tools/psb_c_glob_transpose.F90 index 1509cf33..aa342bdb 100644 --- a/base/tools/psb_c_glob_transpose.F90 +++ b/base/tools/psb_c_glob_transpose.F90 @@ -110,7 +110,8 @@ subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd @@ -406,7 +407,8 @@ subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd @@ -709,7 +711,8 @@ subroutine psb_c_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_c_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -760,7 +763,8 @@ subroutine psb_c_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_c_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -811,7 +815,8 @@ subroutine psb_lc_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_lc_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -862,7 +867,8 @@ subroutine psb_lc_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_lc_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index 83a54d32..be2d432c 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -51,7 +51,8 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) ! complex(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -125,7 +126,8 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_c_vect_type),pointer :: ptx, pty complex(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -232,7 +234,8 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) ! complex(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -305,7 +308,8 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_c_vect_type),pointer :: ptx, pty complex(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ diff --git a/base/tools/psb_c_par_csr_spspmm.f90 b/base/tools/psb_c_par_csr_spspmm.f90 index 058d1a62..a236254a 100644 --- a/base/tools/psb_c_par_csr_spspmm.f90 +++ b/base/tools/psb_c_par_csr_spspmm.f90 @@ -73,7 +73,8 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_lc_csr_sparse_mat) :: ltcsr type(psb_c_csr_sparse_mat) :: tcsr @@ -168,7 +169,8 @@ Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_lc_csr_sparse_mat) :: tcsr1 logical :: update_desc_c diff --git a/base/tools/psb_callc.f90 b/base/tools/psb_callc.f90 index 19924fbe..cbc189f0 100644 --- a/base/tools/psb_callc.f90 +++ b/base/tools/psb_callc.f90 @@ -52,7 +52,7 @@ subroutine psb_calloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -133,8 +133,9 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -235,8 +236,9 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_callc_a.f90 b/base/tools/psb_callc_a.f90 index df3a41b1..ffb5a6bb 100644 --- a/base/tools/psb_callc_a.f90 +++ b/base/tools/psb_callc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_calloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_callocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index b7e57549..70649385 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -62,7 +62,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -135,7 +136,8 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me, i, n + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -217,7 +219,8 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ diff --git a/base/tools/psb_casb_a.f90 b/base/tools/psb_casb_a.f90 index 5d4e4d6a..887cc7c9 100644 --- a/base/tools/psb_casb_a.f90 +++ b/base/tools/psb_casb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_casb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_casbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index b039cbeb..02041a2a 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -90,7 +90,9 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - integer(psb_mpk_) :: icomm, ictxt, me, np, minfo + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) @@ -701,7 +703,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 010901b5..44950748 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -49,11 +49,11 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) use psb_hash_map_mod implicit None !....Parameters... - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_lpk_), intent(in) :: v(:) - integer(psb_ipk_), intent(out) :: info - type(psb_desc_type), intent(out) :: desc - logical, intent(in), optional :: globalcheck,usehash + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_lpk_), intent(in) :: v(:) + integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(out) :: desc + logical, intent(in), optional :: globalcheck,usehash integer(psb_ipk_), intent(in), optional :: idx(:) !locals diff --git a/base/tools/psb_cd_lstext.f90 b/base/tools/psb_cd_lstext.f90 index d8f60f25..06d5c7e7 100644 --- a/base/tools/psb_cd_lstext.f90 +++ b/base/tools/psb_cd_lstext.f90 @@ -38,15 +38,16 @@ Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) ! .. Array Arguments .. Type(psb_desc_type), Intent(inout), target :: desc_a - integer(psb_lpk_), intent(in) :: in_list(:) + integer(psb_lpk_), intent(in) :: in_list(:) Type(psb_desc_type), Intent(out) :: desc_ov - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info logical, intent(in), optional, target :: mask(:) - integer(psb_ipk_), intent(in),optional :: extype + integer(psb_ipk_), intent(in),optional :: extype ! .. Local Scalars .. - integer(psb_ipk_) :: i, j, np, me,m,nnzero,& - & ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),& + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: i, j, np, me,m,nnzero,& + & lovr, lworks,lworkr, n_row,n_col, int_err(5),& & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& & n_elem_send,tot_recv,tot_elem,cntov_o,& diff --git a/base/tools/psb_cd_reinit.f90 b/base/tools/psb_cd_reinit.f90 index 15dbbc59..b33c6eef 100644 --- a/base/tools/psb_cd_reinit.f90 +++ b/base/tools/psb_cd_reinit.f90 @@ -41,13 +41,14 @@ Subroutine psb_cd_reinit(desc,info) Type(psb_desc_type), Intent(inout) :: desc integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: icomm, err_act ! .. Local Scalars .. - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act + integer(psb_mpk_) :: icomm integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ext(:), tmp_ovr(:) - integer(psb_ipk_) :: debug_level, debug_unit - character(len=20) :: name, ch_err + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name, ch_err name='psb_cd_reinit' info = psb_success_ diff --git a/base/tools/psb_cd_renum_block.F90 b/base/tools/psb_cd_renum_block.F90 index 1d64a09e..2b9203e2 100644 --- a/base/tools/psb_cd_renum_block.F90 +++ b/base/tools/psb_cd_renum_block.F90 @@ -53,10 +53,11 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) type(psb_gen_block_map), allocatable :: blck_map integer(psb_ipk_), allocatable :: lidx(:),reflidx(:) integer(psb_lpk_), allocatable :: gidx(:),vnl(:) - integer(psb_ipk_) :: i, n_row, n_col - integer(psb_lpk_) :: li, n_glob_row, n_glob_col - integer(psb_ipk_) :: np, me, ictxt, err_act - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: i, n_row, n_col + integer(psb_lpk_) :: li, n_glob_row, n_glob_col + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act + integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name debug_unit = psb_get_debug_unit() diff --git a/base/tools/psb_cd_set_bld.f90 b/base/tools/psb_cd_set_bld.f90 index 54133cf5..71f6ac85 100644 --- a/base/tools/psb_cd_set_bld.f90 +++ b/base/tools/psb_cd_set_bld.f90 @@ -53,7 +53,8 @@ subroutine psb_cd_set_bld(desc,info) type(psb_desc_type), intent(inout) :: desc integer(psb_ipk_) :: info !locals - integer(psb_ipk_) :: np,me,ictxt, err_act,idx,gidx,lidx,nc + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act,idx,gidx,lidx,nc logical, parameter :: debug=.false.,debugprt=.false. character(len=20) :: name if (debug) write(psb_err_unit,*) me,'Entered CDCPY' @@ -64,7 +65,7 @@ subroutine psb_cd_set_bld(desc,info) ictxt = desc%get_context() - if (debug) write(psb_err_unit,*)'Entered CDSETBLD',ictxt + if (debug) write(psb_err_unit,*)'Entered CDSETBLD' ! check on blacs grid call psb_info(ictxt, me, np) if (debug) write(psb_err_unit,*) me,'Entered CDSETBLD' diff --git a/base/tools/psb_cd_switch_ovl_indxmap.f90 b/base/tools/psb_cd_switch_ovl_indxmap.f90 index b2bdd9e4..80eca15a 100644 --- a/base/tools/psb_cd_switch_ovl_indxmap.f90 +++ b/base/tools/psb_cd_switch_ovl_indxmap.f90 @@ -45,9 +45,10 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) integer(psb_ipk_), intent(out) :: info ! .. Local Scalars .. - integer(psb_ipk_) :: i, j, np, me, ictxt, n_row, n_col - integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: i, j, np, me, n_row, n_col + integer(psb_lpk_) :: mglob + integer(psb_ipk_) :: err_act integer(psb_lpk_), allocatable :: vl(:) integer(psb_ipk_) :: debug_level, debug_unit, ierr(5) diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index 15ce572f..69cf82e4 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -1,4 +1,5 @@ -subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalcheck,lidx,usehash) +subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& + & vg,vl,flag,nl,repl,globalcheck,lidx,usehash) use psb_desc_mod use psb_serial_mod use psb_const_mod @@ -7,13 +8,14 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec use psb_cd_tools_mod, psb_protect_name => psb_cdall use psi_mod implicit None - procedure(psb_parts) :: parts - integer(psb_lpk_), intent(in) :: mg,ng, vl(:) - integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl - integer(psb_ipk_), intent(in) :: flag - logical, intent(in) :: repl, globalcheck,usehash - integer(psb_ipk_), intent(out) :: info - type(psb_desc_type), intent(out) :: desc + procedure(psb_parts) :: parts + integer(psb_lpk_), intent(in) :: mg,ng, vl(:) + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: vg(:), lidx(:),nl + integer(psb_ipk_), intent(in) :: flag + logical, intent(in) :: repl, globalcheck,usehash + integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(out) :: desc optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx, usehash @@ -22,13 +24,14 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec use psb_desc_mod procedure(psb_parts) :: parts integer(psb_lpk_), intent(in) :: m,n - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt Type(psb_desc_type), intent(out) :: desc integer(psb_ipk_), intent(out) :: info end subroutine psb_cdals subroutine psb_cdalv(v, ictxt, desc, info, flag) use psb_desc_mod - integer(psb_ipk_), intent(in) :: ictxt, v(:) + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: v(:) integer(psb_ipk_), intent(in), optional :: flag integer(psb_ipk_), intent(out) :: info Type(psb_desc_type), intent(out) :: desc @@ -36,7 +39,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx, usehash) use psb_desc_mod implicit None - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: v(:) integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc @@ -46,7 +49,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec subroutine psb_cdrep(m, ictxt, desc,info) use psb_desc_mod integer(psb_lpk_), intent(in) :: m - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt + + Type(psb_desc_type), intent(out) :: desc integer(psb_ipk_), intent(out) :: info end subroutine psb_cdrep diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index dfee4113..945d2c40 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -50,12 +50,12 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) use psb_list_map_mod use psb_hash_map_mod implicit None - procedure(psb_parts) :: parts + procedure(psb_parts) :: parts !....Parameters... - integer(psb_lpk_), intent(in) :: M,N - integer(psb_ipk_), intent(in) :: ictxt - Type(psb_desc_type), intent(out) :: desc - integer(psb_ipk_), intent(out) :: info + integer(psb_lpk_), intent(in) :: M,N + type(psb_ctxt_type), intent(in) :: ictxt + Type(psb_desc_type), intent(out) :: desc + integer(psb_ipk_), intent(out) :: info !locals integer(psb_ipk_) :: counter,i,j,loc_row,err,loc_col,& diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index 8b850f6b..fa0795a7 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -51,9 +51,10 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) use psb_hash_map_mod implicit None !....Parameters... - integer(psb_ipk_), intent(in) :: ictxt, v(:) - integer(psb_ipk_), intent(in), optional :: flag - integer(psb_ipk_), intent(out) :: info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_), intent(in) :: v(:) + integer(psb_ipk_), intent(in), optional :: flag + integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc !locals diff --git a/base/tools/psb_cdcpy.F90 b/base/tools/psb_cdcpy.F90 index 7605006a..2977ccc2 100644 --- a/base/tools/psb_cdcpy.F90 +++ b/base/tools/psb_cdcpy.F90 @@ -29,14 +29,14 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! - ! - ! Subroutine: psb_cdcpy - ! Produces a clone of a descriptor. - ! - ! Arguments: - ! desc_in - type(psb_desc_type). The communication descriptor to be cloned. - ! desc_out - type(psb_desc_type). The output communication descriptor. - ! info - integer. Return code. +! +! Subroutine: psb_cdcpy +! Produces a clone of a descriptor. +! +! Arguments: +! desc_in - type(psb_desc_type). The communication descriptor to be cloned. +! desc_out - type(psb_desc_type). The output communication descriptor. +! info - integer. Return code. subroutine psb_cdcpy(desc_in, desc_out, info) use psb_base_mod, psb_protect_name => psb_cdcpy @@ -49,7 +49,8 @@ subroutine psb_cdcpy(desc_in, desc_out, info) integer(psb_ipk_), intent(out) :: info !locals - integer(psb_ipk_) :: np,me,ictxt, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_cdins.F90 b/base/tools/psb_cdins.F90 index d1b186f9..cc1fd1ef 100644 --- a/base/tools/psb_cdins.F90 +++ b/base/tools/psb_cdins.F90 @@ -74,11 +74,12 @@ subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) integer(psb_lpk_), intent(in) :: ia(:),ja(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) - !LOCALS..... - integer(psb_ipk_) :: ictxt,dectype,mglob, nglob - integer(psb_ipk_) :: np, me - integer(psb_ipk_) :: nrow,ncol, err_act + !LOCALS..... + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: dectype,mglob, nglob + integer(psb_ipk_) :: np, me + integer(psb_ipk_) :: nrow,ncol, err_act logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila_(:), jla_(:) @@ -218,11 +219,11 @@ subroutine psb_lcdinsc(nz,ja,desc,info,jla,mask,lidx) !LOCALS..... - - integer(psb_ipk_) :: ictxt,dectype,mglob, nglob - integer(psb_ipk_) :: np, me - integer(psb_ipk_) :: nrow,ncol, err_act - logical, parameter :: debug=.false. + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: dectype,mglob, nglob + integer(psb_ipk_) :: np, me + integer(psb_ipk_) :: nrow,ncol, err_act + logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila_(:), jla_(:) character(len=20) :: name diff --git a/base/tools/psb_cdprt.f90 b/base/tools/psb_cdprt.f90 index 1f68c73d..2c83af17 100644 --- a/base/tools/psb_cdprt.f90 +++ b/base/tools/psb_cdprt.f90 @@ -52,10 +52,11 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) integer(psb_ipk_) :: m, n_row, n_col,counter,idx,& & n_elem_recv,n_elem_send,proc,i, verb_ - integer(psb_ipk_) :: ictxt, me, np - integer(psb_ipk_) :: total_snd, total_rcv, total_xhcg, global_halo, global_points - integer(psb_ipk_) :: local_snd, local_rcv, local_xhcg, local_halo, local_points - real(psb_dpk_) :: av2s, v2s + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np + integer(psb_ipk_) :: total_snd, total_rcv, total_xhcg, global_halo, global_points + integer(psb_ipk_) :: local_snd, local_rcv, local_xhcg, local_halo, local_points + real(psb_dpk_) :: av2s, v2s if (present(glob)) then glob_ = glob @@ -147,8 +148,9 @@ contains logical, intent(in), optional :: glob,short logical :: short_, glob_ - integer(psb_ipk_) :: ip, nerv, nesd, totxch,idxr,idxs - integer(psb_ipk_) :: ictxt, me, np, data_, info, verb_ + integer(psb_ipk_) :: ip, nerv, nesd, totxch,idxr,idxs + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, data_, info, verb_ integer(psb_lpk_), allocatable :: gidx(:) class(psb_i_base_vect_type), pointer :: vpnt diff --git a/base/tools/psb_cdren.f90 b/base/tools/psb_cdren.f90 index 95568a8e..9a065028 100644 --- a/base/tools/psb_cdren.f90 +++ b/base/tools/psb_cdren.f90 @@ -56,11 +56,12 @@ subroutine psb_cdren(trans,iperm,desc_a,info) character, intent(in) :: trans integer(psb_ipk_), intent(out) :: info !....locals.... - integer(psb_ipk_) :: i,j,np,me, n_col, kh, nh - integer(psb_ipk_) :: dectype - integer(psb_ipk_) :: ictxt,n_row, err_act - integer(psb_ipk_) :: debug_level, debug_unit - character(len=20) :: name + integer(psb_ipk_) :: i,j,np,me, n_col, kh, nh + integer(psb_ipk_) :: dectype + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: n_row, err_act + integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ diff --git a/base/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 index 2ba47c2c..93d7e348 100644 --- a/base/tools/psb_cdrep.f90 +++ b/base/tools/psb_cdrep.f90 @@ -29,88 +29,88 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! - ! Purpose - ! == = ==== - ! - ! Allocate special descriptor for replicated index space. - ! - ! - ! - ! INPUT - ! == ==== - ! M :(Global Input) Integer - ! Total number of equations - ! required. - ! - ! ictxt : (Global Input)Integer BLACS context for an NPx1 grid - ! required. - ! - ! OUTPUT - ! == ======= - ! desc : TYPEDESC - ! desc OUTPUT FIELDS: - ! - ! MATRIX_DATA : Pointer to integer Array - ! contains some - ! local and global information about matrix: - ! - ! NOTATION STORED IN EXPLANATION - ! ------------ ---------------------- ------------------------------------- - ! DEC_TYPE MATRIX_DATA[DEC_TYPE_] Decomposition type, temporarly is - ! setted to 1( matrix not yet assembled) - ! M MATRIX_DATA[M_] Total number of equations - ! N MATRIX_DATA[N_] Total number of variables - ! N_ROW MATRIX_DATA[N_ROW_] Number of local equations - ! N_COL MATRIX_DATA[N_COL_] Number of local columns (see below) - ! CTXT_A MATRIX_DATA[CTXT_] The BLACS context handle, - ! indicating - ! the global context of the operation - ! on the matrix. - ! The context itself is global. - ! - ! GLOB_TO_LOC Array of dimension equal to number of global - ! rows/cols (MATRIX_DATA[M_]). On exit, - ! for all global indices either: - ! 1. The index belongs to the current process; the entry - ! is set to the next free local row index. - ! 2. The index belongs to process P (0<=P<=NP-1); the entry - ! is set to - ! -(NP+P+1) - ! - ! LOC_TO_GLOB An array of dimension equal to number of local cols N_COL - ! i.e. all columns of the matrix such that there is at least - ! one nonzero entry within the local row range. At the time - ! this routine is called N_COL cannot be know, so we set - ! N_COL=N_ROW, and dimension this vector on N_ROW plus an - ! estimate. On exit the vector elements are set - ! to the index of the corresponding entry in GLOB_TO_LOC, or - ! to -1 for indices I>N_ROW. - ! - ! - ! HALO_INDEX Not touched here, as it depends on the matrix pattern - ! - ! OVRLAP_INDEX On exit from this routine, the overlap indices are stored in - ! triples (Proc, 1, Index), similar to the assembled format - ! but neither optimized, nor deadlock free. - ! List is terminated with -1 - ! - ! OVRLAP_ELEM On exit from this routine, just a list of pairs (index,#p). - ! List is terminated with -1. - ! - ! - ! END OF desc OUTPUT FIELDS - ! - ! +! Purpose +! == = ==== +! +! Allocate special descriptor for replicated index space. +! +! +! +! INPUT +! == ==== +! M :(Global Input) Integer +! Total number of equations +! required. +! +! ictxt : (Global Input)Integer BLACS context for an NPx1 grid +! required. +! +! OUTPUT +! == ======= +! desc : TYPEDESC +! desc OUTPUT FIELDS: +! +! MATRIX_DATA : Pointer to integer Array +! contains some +! local and global information about matrix: +! +! NOTATION STORED IN EXPLANATION +! ------------ ---------------------- ------------------------------------- +! DEC_TYPE MATRIX_DATA[DEC_TYPE_] Decomposition type, temporarly is +! setted to 1( matrix not yet assembled) +! M MATRIX_DATA[M_] Total number of equations +! N MATRIX_DATA[N_] Total number of variables +! N_ROW MATRIX_DATA[N_ROW_] Number of local equations +! N_COL MATRIX_DATA[N_COL_] Number of local columns (see below) +! CTXT_A MATRIX_DATA[CTXT_] The BLACS context handle, +! indicating +! the global context of the operation +! on the matrix. +! The context itself is global. +! +! GLOB_TO_LOC Array of dimension equal to number of global +! rows/cols (MATRIX_DATA[M_]). On exit, +! for all global indices either: +! 1. The index belongs to the current process; the entry +! is set to the next free local row index. +! 2. The index belongs to process P (0<=P<=NP-1); the entry +! is set to +! -(NP+P+1) +! +! LOC_TO_GLOB An array of dimension equal to number of local cols N_COL +! i.e. all columns of the matrix such that there is at least +! one nonzero entry within the local row range. At the time +! this routine is called N_COL cannot be know, so we set +! N_COL=N_ROW, and dimension this vector on N_ROW plus an +! estimate. On exit the vector elements are set +! to the index of the corresponding entry in GLOB_TO_LOC, or +! to -1 for indices I>N_ROW. +! +! +! HALO_INDEX Not touched here, as it depends on the matrix pattern +! +! OVRLAP_INDEX On exit from this routine, the overlap indices are stored in +! triples (Proc, 1, Index), similar to the assembled format +! but neither optimized, nor deadlock free. +! List is terminated with -1 +! +! OVRLAP_ELEM On exit from this routine, just a list of pairs (index,#p). +! List is terminated with -1. +! +! +! END OF desc OUTPUT FIELDS +! +! subroutine psb_cdrep(m, ictxt, desc, info) use psb_base_mod use psi_mod use psb_repl_map_mod implicit None !....Parameters... - integer(psb_lpk_), intent(in) :: m - integer(psb_ipk_), intent(in) :: ictxt - integer(psb_ipk_), intent(out) :: info - Type(psb_desc_type), intent(out) :: desc + integer(psb_lpk_), intent(in) :: m + type(psb_ctxt_type), intent(in) :: ictxt + integer(psb_ipk_), intent(out) :: info + Type(psb_desc_type), intent(out) :: desc !locals integer(psb_ipk_) :: i,np,me,err,err_act diff --git a/base/tools/psb_cfree.f90 b/base/tools/psb_cfree.f90 index 2d38887a..a5f79d8e 100644 --- a/base/tools/psb_cfree.f90 +++ b/base/tools/psb_cfree.f90 @@ -46,7 +46,8 @@ subroutine psb_cfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -100,7 +101,8 @@ subroutine psb_cfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -152,7 +154,8 @@ subroutine psb_cfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name diff --git a/base/tools/psb_cfree_a.f90 b/base/tools/psb_cfree_a.f90 index 38621be4..dadb05a7 100644 --- a/base/tools/psb_cfree_a.f90 +++ b/base/tools/psb_cfree_a.f90 @@ -48,7 +48,8 @@ subroutine psb_cfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_cfree' @@ -116,7 +117,8 @@ subroutine psb_cfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_cfreev' diff --git a/base/tools/psb_cgetelem.f90 b/base/tools/psb_cgetelem.f90 index 728b4d1e..2dc981e0 100644 --- a/base/tools/psb_cgetelem.f90 +++ b/base/tools/psb_cgetelem.f90 @@ -55,7 +55,8 @@ function psb_c_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) character(len=20) :: name diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index cfb82b88..45f99156 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -63,7 +63,8 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -190,7 +191,8 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) complex(psb_spk_), allocatable :: lval(:) logical :: local_ @@ -295,7 +297,8 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -409,7 +412,8 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_cins_a.f90 b/base/tools/psb_cins_a.f90 index 6e67a0e6..9fab5c02 100644 --- a/base/tools/psb_cins_a.f90 +++ b/base/tools/psb_cins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index b67aeede..d73a99dd 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -52,7 +52,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index 073fcbbd..ef4fd438 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -62,7 +62,8 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_c_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err diff --git a/base/tools/psb_cspfree.f90 b/base/tools/psb_cspfree.f90 index 6defa911..9a908d1b 100644 --- a/base/tools/psb_cspfree.f90 +++ b/base/tools/psb_cspfree.f90 @@ -48,7 +48,8 @@ subroutine psb_cspfree(a, desc_a,info) type(psb_cspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: err_act character(len=20) :: name info=psb_success_ diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index 79b2b5b7..ced2d5ff 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -90,7 +90,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -557,7 +558,8 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg @@ -900,7 +902,8 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs @@ -1260,7 +1263,8 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,ngtz, idx, nxs, nxr, err_act, & diff --git a/base/tools/psb_cspins.F90 b/base/tools/psb_cspins.F90 index c2a52eb3..bc5ff7c5 100644 --- a/base/tools/psb_cspins.F90 +++ b/base/tools/psb_cspins.F90 @@ -64,7 +64,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -208,7 +209,8 @@ subroutine psb_cspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -306,7 +308,8 @@ subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -403,7 +406,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) @@ -518,7 +522,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ diff --git a/base/tools/psb_csprn.f90 b/base/tools/psb_csprn.f90 index 3912cdae..1dc4da91 100644 --- a/base/tools/psb_csprn.f90 +++ b/base/tools/psb_csprn.f90 @@ -53,7 +53,8 @@ Subroutine psb_csprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name logical :: clear_ diff --git a/base/tools/psb_d_glob_transpose.F90 b/base/tools/psb_d_glob_transpose.F90 index 638ba174..938adb0f 100644 --- a/base/tools/psb_d_glob_transpose.F90 +++ b/base/tools/psb_d_glob_transpose.F90 @@ -110,7 +110,8 @@ subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd @@ -406,7 +407,8 @@ subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd @@ -709,7 +711,8 @@ subroutine psb_d_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_d_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -760,7 +763,8 @@ subroutine psb_d_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_d_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -811,7 +815,8 @@ subroutine psb_ld_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_ld_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -862,7 +867,8 @@ subroutine psb_ld_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_ld_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 51672121..18bbc0ec 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -51,7 +51,8 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) ! real(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -125,7 +126,8 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_d_vect_type),pointer :: ptx, pty real(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -232,7 +234,8 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) ! real(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -305,7 +308,8 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_d_vect_type),pointer :: ptx, pty real(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ diff --git a/base/tools/psb_d_par_csr_spspmm.f90 b/base/tools/psb_d_par_csr_spspmm.f90 index 2e34a32c..04deeb3f 100644 --- a/base/tools/psb_d_par_csr_spspmm.f90 +++ b/base/tools/psb_d_par_csr_spspmm.f90 @@ -73,7 +73,8 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_ld_csr_sparse_mat) :: ltcsr type(psb_d_csr_sparse_mat) :: tcsr @@ -168,7 +169,8 @@ Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_ld_csr_sparse_mat) :: tcsr1 logical :: update_desc_c diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index 73611ad7..a2d8214d 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -52,7 +52,7 @@ subroutine psb_dalloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -133,8 +133,9 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -235,8 +236,9 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_dallc_a.f90 b/base/tools/psb_dallc_a.f90 index b9fcf114..2633e088 100644 --- a/base/tools/psb_dallc_a.f90 +++ b/base/tools/psb_dallc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_dallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 1d141cdf..86ee0eb1 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -62,7 +62,8 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -135,7 +136,8 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me, i, n + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -217,7 +219,8 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ diff --git a/base/tools/psb_dasb_a.f90 b/base/tools/psb_dasb_a.f90 index 42a60fbf..82db47d5 100644 --- a/base/tools/psb_dasb_a.f90 +++ b/base/tools/psb_dasb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_dasb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_dasbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index 771e746f..c35e4493 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -90,7 +90,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - integer(psb_mpk_) :: icomm, ictxt, me, np, minfo + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) @@ -701,7 +703,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/tools/psb_dfree.f90 b/base/tools/psb_dfree.f90 index 6c36dd09..7f51dc84 100644 --- a/base/tools/psb_dfree.f90 +++ b/base/tools/psb_dfree.f90 @@ -46,7 +46,8 @@ subroutine psb_dfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -100,7 +101,8 @@ subroutine psb_dfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -152,7 +154,8 @@ subroutine psb_dfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name diff --git a/base/tools/psb_dfree_a.f90 b/base/tools/psb_dfree_a.f90 index a33c41be..a5087078 100644 --- a/base/tools/psb_dfree_a.f90 +++ b/base/tools/psb_dfree_a.f90 @@ -48,7 +48,8 @@ subroutine psb_dfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_dfree' @@ -116,7 +117,8 @@ subroutine psb_dfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_dfreev' diff --git a/base/tools/psb_dgetelem.f90 b/base/tools/psb_dgetelem.f90 index 0611221e..8058b897 100644 --- a/base/tools/psb_dgetelem.f90 +++ b/base/tools/psb_dgetelem.f90 @@ -55,7 +55,8 @@ function psb_d_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) character(len=20) :: name diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index ad7f8d90..4ee99acc 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -63,7 +63,8 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -190,7 +191,8 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) real(psb_dpk_), allocatable :: lval(:) logical :: local_ @@ -295,7 +297,8 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -409,7 +412,8 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_dins_a.f90 b/base/tools/psb_dins_a.f90 index 9aee33bd..96a8d669 100644 --- a/base/tools/psb_dins_a.f90 +++ b/base/tools/psb_dins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index 9ae4572a..1f623a64 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -52,7 +52,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 542e6901..03193e66 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -62,7 +62,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_d_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err diff --git a/base/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 index ee8388ce..201c6b4f 100644 --- a/base/tools/psb_dspfree.f90 +++ b/base/tools/psb_dspfree.f90 @@ -48,7 +48,8 @@ subroutine psb_dspfree(a, desc_a,info) type(psb_dspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: err_act character(len=20) :: name info=psb_success_ diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 24949cff..d4487757 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -90,7 +90,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -557,7 +558,8 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg @@ -900,7 +902,8 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs @@ -1260,7 +1263,8 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,ngtz, idx, nxs, nxr, err_act, & diff --git a/base/tools/psb_dspins.F90 b/base/tools/psb_dspins.F90 index 4018a36a..9816aade 100644 --- a/base/tools/psb_dspins.F90 +++ b/base/tools/psb_dspins.F90 @@ -64,7 +64,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -208,7 +209,8 @@ subroutine psb_dspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -306,7 +308,8 @@ subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -403,7 +406,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) @@ -518,7 +522,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ diff --git a/base/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 index c5f81e48..ebd05185 100644 --- a/base/tools/psb_dsprn.f90 +++ b/base/tools/psb_dsprn.f90 @@ -53,7 +53,8 @@ Subroutine psb_dsprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name logical :: clear_ diff --git a/base/tools/psb_eallc_a.f90 b/base/tools/psb_eallc_a.f90 index 5f6e3c36..6d360c31 100644 --- a/base/tools/psb_eallc_a.f90 +++ b/base/tools/psb_eallc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_eallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_easb_a.f90 b/base/tools/psb_easb_a.f90 index 5c62aa59..c93af356 100644 --- a/base/tools/psb_easb_a.f90 +++ b/base/tools/psb_easb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_easb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_easbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_efree_a.f90 b/base/tools/psb_efree_a.f90 index c07ee694..738c5c3f 100644 --- a/base/tools/psb_efree_a.f90 +++ b/base/tools/psb_efree_a.f90 @@ -48,7 +48,8 @@ subroutine psb_efree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_efree' @@ -116,7 +117,8 @@ subroutine psb_efreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_efreev' diff --git a/base/tools/psb_eins_a.f90 b/base/tools/psb_eins_a.f90 index 3923a265..87cf75d3 100644 --- a/base/tools/psb_eins_a.f90 +++ b/base/tools/psb_eins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_get_overlap.f90 b/base/tools/psb_get_overlap.f90 index 9563754f..9ef3377e 100644 --- a/base/tools/psb_get_overlap.f90 +++ b/base/tools/psb_get_overlap.f90 @@ -47,7 +47,7 @@ subroutine psb_get_ovrlap(ovrel,desc,info) implicit none integer(psb_ipk_), allocatable, intent(out) :: ovrel(:) type(psb_desc_type), intent(in) :: desc - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: i,j, err_act character(len=20) :: name @@ -56,7 +56,7 @@ subroutine psb_get_ovrlap(ovrel,desc,info) name='psi_get_overlap' call psb_erractionsave(err_act) - if (.not.psb_is_asb_desc(desc)) then + if (.not.desc%is_asb()) then info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 79799d19..240c1efc 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -59,7 +59,8 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) logical, intent(in), optional :: owned !....locals.... - integer(psb_ipk_) :: n, ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: n, iam, np character :: act integer(psb_ipk_) :: err_act character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) character :: act integer(psb_ipk_) :: err_act character(len=20) :: name - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np if(psb_get_errstatus() /= 0) return info=psb_success_ diff --git a/base/tools/psb_i2allc_a.f90 b/base/tools/psb_i2allc_a.f90 index 3d453ea8..c7305e0c 100644 --- a/base/tools/psb_i2allc_a.f90 +++ b/base/tools/psb_i2allc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_i2alloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_i2allocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_i2asb_a.f90 b/base/tools/psb_i2asb_a.f90 index 4e7cc9b0..b76c39ff 100644 --- a/base/tools/psb_i2asb_a.f90 +++ b/base/tools/psb_i2asb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_i2asb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_i2asbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_i2free_a.f90 b/base/tools/psb_i2free_a.f90 index 5e673626..e1892cab 100644 --- a/base/tools/psb_i2free_a.f90 +++ b/base/tools/psb_i2free_a.f90 @@ -48,7 +48,8 @@ subroutine psb_i2free(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_i2free' @@ -116,7 +117,8 @@ subroutine psb_i2freev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_i2freev' diff --git a/base/tools/psb_i2ins_a.f90 b/base/tools/psb_i2ins_a.f90 index 76d7c260..1db07847 100644 --- a/base/tools/psb_i2ins_a.f90 +++ b/base/tools/psb_i2ins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_i2insvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_i2insi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_iallc.f90 b/base/tools/psb_iallc.f90 index 65f5f1da..1dbb09f4 100644 --- a/base/tools/psb_iallc.f90 +++ b/base/tools/psb_iallc.f90 @@ -52,7 +52,7 @@ subroutine psb_ialloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -133,8 +133,9 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -235,8 +236,9 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index 52fbe165..1326a5e9 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -62,7 +62,8 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -135,7 +136,8 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me, i, n + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -217,7 +219,8 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index b68485ee..6c2fd03e 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -63,7 +63,9 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) integer(psb_ipk_),allocatable :: ovrlap_index(:),halo_index(:), ext_index(:) integer(psb_ipk_) :: i, n_col, dectype, err_act, n_row - integer(psb_mpk_) :: np,me, icomm, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_mpk_) :: icomm + integer(psb_ipk_) :: np,me logical :: ext_hv_ logical, parameter :: do_timings=.true. integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 @@ -191,7 +193,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/tools/psb_ifree.f90 b/base/tools/psb_ifree.f90 index 516f1219..2dbc0b80 100644 --- a/base/tools/psb_ifree.f90 +++ b/base/tools/psb_ifree.f90 @@ -46,7 +46,8 @@ subroutine psb_ifree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -100,7 +101,8 @@ subroutine psb_ifree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -152,7 +154,8 @@ subroutine psb_ifree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index 48aa97fb..9366a656 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -63,7 +63,8 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -190,7 +191,8 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: lval(:) logical :: local_ @@ -295,7 +297,8 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -409,7 +412,8 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_lallc.f90 b/base/tools/psb_lallc.f90 index e397f7cb..99870a11 100644 --- a/base/tools/psb_lallc.f90 +++ b/base/tools/psb_lallc.f90 @@ -52,7 +52,7 @@ subroutine psb_lalloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -133,8 +133,9 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -235,8 +236,9 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_lasb.f90 b/base/tools/psb_lasb.f90 index c1835b05..f7ab7824 100644 --- a/base/tools/psb_lasb.f90 +++ b/base/tools/psb_lasb.f90 @@ -62,7 +62,8 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -135,7 +136,8 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me, i, n + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -217,7 +219,8 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ diff --git a/base/tools/psb_lfree.f90 b/base/tools/psb_lfree.f90 index d6c597a8..85d7bd7e 100644 --- a/base/tools/psb_lfree.f90 +++ b/base/tools/psb_lfree.f90 @@ -46,7 +46,8 @@ subroutine psb_lfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -100,7 +101,8 @@ subroutine psb_lfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -152,7 +154,8 @@ subroutine psb_lfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name diff --git a/base/tools/psb_lins.f90 b/base/tools/psb_lins.f90 index d7c044d1..8db980e9 100644 --- a/base/tools/psb_lins.f90 +++ b/base/tools/psb_lins.f90 @@ -63,7 +63,8 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -190,7 +191,8 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) integer(psb_lpk_), allocatable :: lval(:) logical :: local_ @@ -295,7 +297,8 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -409,7 +412,8 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_mallc_a.f90 b/base/tools/psb_mallc_a.f90 index 2bcedc5b..fc545678 100644 --- a/base/tools/psb_mallc_a.f90 +++ b/base/tools/psb_mallc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_malloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_mallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_masb_a.f90 b/base/tools/psb_masb_a.f90 index 47c35d2a..7999cb03 100644 --- a/base/tools/psb_masb_a.f90 +++ b/base/tools/psb_masb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_masb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_masbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_mfree_a.f90 b/base/tools/psb_mfree_a.f90 index 49f255da..3f534b2b 100644 --- a/base/tools/psb_mfree_a.f90 +++ b/base/tools/psb_mfree_a.f90 @@ -48,7 +48,8 @@ subroutine psb_mfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_mfree' @@ -116,7 +117,8 @@ subroutine psb_mfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_mfreev' diff --git a/base/tools/psb_mins_a.f90 b/base/tools/psb_mins_a.f90 index 6d83b724..fa3ff081 100644 --- a/base/tools/psb_mins_a.f90 +++ b/base/tools/psb_mins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_s_glob_transpose.F90 b/base/tools/psb_s_glob_transpose.F90 index 875f92db..e747b270 100644 --- a/base/tools/psb_s_glob_transpose.F90 +++ b/base/tools/psb_s_glob_transpose.F90 @@ -110,7 +110,8 @@ subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd @@ -406,7 +407,8 @@ subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd @@ -709,7 +711,8 @@ subroutine psb_s_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_s_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -760,7 +763,8 @@ subroutine psb_s_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_s_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -811,7 +815,8 @@ subroutine psb_ls_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_ls_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -862,7 +867,8 @@ subroutine psb_ls_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_ls_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index 6fa9b7b7..f20ff196 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -51,7 +51,8 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) ! real(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -125,7 +126,8 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_s_vect_type),pointer :: ptx, pty real(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -232,7 +234,8 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) ! real(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -305,7 +308,8 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_s_vect_type),pointer :: ptx, pty real(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ diff --git a/base/tools/psb_s_par_csr_spspmm.f90 b/base/tools/psb_s_par_csr_spspmm.f90 index fba99f27..928ff101 100644 --- a/base/tools/psb_s_par_csr_spspmm.f90 +++ b/base/tools/psb_s_par_csr_spspmm.f90 @@ -73,7 +73,8 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_ls_csr_sparse_mat) :: ltcsr type(psb_s_csr_sparse_mat) :: tcsr @@ -168,7 +169,8 @@ Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_ls_csr_sparse_mat) :: tcsr1 logical :: update_desc_c diff --git a/base/tools/psb_sallc.f90 b/base/tools/psb_sallc.f90 index 6e20f82e..e4286f40 100644 --- a/base/tools/psb_sallc.f90 +++ b/base/tools/psb_sallc.f90 @@ -52,7 +52,7 @@ subroutine psb_salloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -133,8 +133,9 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -235,8 +236,9 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_sallc_a.f90 b/base/tools/psb_sallc_a.f90 index 815acb61..6f783584 100644 --- a/base/tools/psb_sallc_a.f90 +++ b/base/tools/psb_sallc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_salloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_sallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index 67d4ac92..36b98c7c 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -62,7 +62,8 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -135,7 +136,8 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me, i, n + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -217,7 +219,8 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ diff --git a/base/tools/psb_sasb_a.f90 b/base/tools/psb_sasb_a.f90 index bef96be7..4ce6201a 100644 --- a/base/tools/psb_sasb_a.f90 +++ b/base/tools/psb_sasb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_sasb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_sasbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index 34047ded..d57e20ed 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -90,7 +90,9 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - integer(psb_mpk_) :: icomm, ictxt, me, np, minfo + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) @@ -701,7 +703,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/tools/psb_sfree.f90 b/base/tools/psb_sfree.f90 index 34f03cae..39e01666 100644 --- a/base/tools/psb_sfree.f90 +++ b/base/tools/psb_sfree.f90 @@ -46,7 +46,8 @@ subroutine psb_sfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -100,7 +101,8 @@ subroutine psb_sfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -152,7 +154,8 @@ subroutine psb_sfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name diff --git a/base/tools/psb_sfree_a.f90 b/base/tools/psb_sfree_a.f90 index 6d7412d0..7cddb76f 100644 --- a/base/tools/psb_sfree_a.f90 +++ b/base/tools/psb_sfree_a.f90 @@ -48,7 +48,8 @@ subroutine psb_sfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_sfree' @@ -116,7 +117,8 @@ subroutine psb_sfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_sfreev' diff --git a/base/tools/psb_sgetelem.f90 b/base/tools/psb_sgetelem.f90 index 6a8f764e..f0eceee2 100644 --- a/base/tools/psb_sgetelem.f90 +++ b/base/tools/psb_sgetelem.f90 @@ -55,7 +55,8 @@ function psb_s_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) character(len=20) :: name diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 85b68322..8fc5c312 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -63,7 +63,8 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -190,7 +191,8 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) real(psb_spk_), allocatable :: lval(:) logical :: local_ @@ -295,7 +297,8 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -409,7 +412,8 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_sins_a.f90 b/base/tools/psb_sins_a.f90 index 51bd0bbd..bf0c7e42 100644 --- a/base/tools/psb_sins_a.f90 +++ b/base/tools/psb_sins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index 4b092e62..7092ab4b 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -52,7 +52,8 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index 01187497..87d34f86 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -62,7 +62,8 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_s_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err diff --git a/base/tools/psb_sspfree.f90 b/base/tools/psb_sspfree.f90 index aa4cea76..f55c8718 100644 --- a/base/tools/psb_sspfree.f90 +++ b/base/tools/psb_sspfree.f90 @@ -48,7 +48,8 @@ subroutine psb_sspfree(a, desc_a,info) type(psb_sspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: err_act character(len=20) :: name info=psb_success_ diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index f8958a45..f6fad075 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -90,7 +90,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -557,7 +558,8 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg @@ -900,7 +902,8 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs @@ -1260,7 +1263,8 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,ngtz, idx, nxs, nxr, err_act, & diff --git a/base/tools/psb_sspins.F90 b/base/tools/psb_sspins.F90 index 7a86e559..464dd953 100644 --- a/base/tools/psb_sspins.F90 +++ b/base/tools/psb_sspins.F90 @@ -64,7 +64,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -208,7 +209,8 @@ subroutine psb_sspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -306,7 +308,8 @@ subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -403,7 +406,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) @@ -518,7 +522,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ diff --git a/base/tools/psb_ssprn.f90 b/base/tools/psb_ssprn.f90 index 3a750033..663ba185 100644 --- a/base/tools/psb_ssprn.f90 +++ b/base/tools/psb_ssprn.f90 @@ -53,7 +53,8 @@ Subroutine psb_ssprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name logical :: clear_ diff --git a/base/tools/psb_z_glob_transpose.F90 b/base/tools/psb_z_glob_transpose.F90 index 8f7cadd5..4ee53c38 100644 --- a/base/tools/psb_z_glob_transpose.F90 +++ b/base/tools/psb_z_glob_transpose.F90 @@ -110,7 +110,8 @@ subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzt, nzd @@ -406,7 +407,8 @@ subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & l1, nsnds, nrcvs, nr,nc,nzl, hlstart, nzd @@ -709,7 +711,8 @@ subroutine psb_z_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_z_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -760,7 +763,8 @@ subroutine psb_z_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_z_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -811,7 +815,8 @@ subroutine psb_lz_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_lz_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname @@ -862,7 +867,8 @@ subroutine psb_lz_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_lz_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - integer(psb_ipk_) :: ictxt, me, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 86858c60..b41f1fc9 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -51,7 +51,8 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) ! complex(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -125,7 +126,8 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_z_vect_type),pointer :: ptx, pty complex(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -232,7 +234,8 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) ! complex(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt + & map_kind, nr + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -305,7 +308,8 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) type(psb_z_vect_type),pointer :: ptx, pty complex(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, nr, ictxt, iam, np + & map_kind, nr, iam, np + type(psb_ctxt_type) :: ictxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ diff --git a/base/tools/psb_z_par_csr_spspmm.f90 b/base/tools/psb_z_par_csr_spspmm.f90 index 3be9d0e8..c59f183f 100644 --- a/base/tools/psb_z_par_csr_spspmm.f90 +++ b/base/tools/psb_z_par_csr_spspmm.f90 @@ -73,7 +73,8 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_lz_csr_sparse_mat) :: ltcsr type(psb_z_csr_sparse_mat) :: tcsr @@ -168,7 +169,8 @@ Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_lz_csr_sparse_mat) :: tcsr1 logical :: update_desc_c diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index 1bf67e74..1c86b430 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -52,7 +52,7 @@ subroutine psb_zalloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -133,8 +133,9 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -235,8 +236,9 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, exch(1) + integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_zallc_a.f90 b/base/tools/psb_zallc_a.f90 index 9fa7993c..96cbfdf9 100644 --- a/base/tools/psb_zallc_a.f90 +++ b/base/tools/psb_zallc_a.f90 @@ -55,7 +55,8 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -183,7 +184,8 @@ subroutine psb_zallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 6ebf4281..883ba129 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -62,7 +62,8 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -135,7 +136,8 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me, i, n + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ integer(psb_ipk_) :: debug_level, debug_unit @@ -217,7 +219,8 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ diff --git a/base/tools/psb_zasb_a.f90 b/base/tools/psb_zasb_a.f90 index 0492475a..6f0e8221 100644 --- a/base/tools/psb_zasb_a.f90 +++ b/base/tools/psb_zasb_a.f90 @@ -52,7 +52,8 @@ subroutine psb_zasb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ @@ -188,7 +189,8 @@ subroutine psb_zasbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit logical :: scratch_ diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index 528e78f5..f53ad714 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -90,7 +90,9 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - integer(psb_mpk_) :: icomm, ictxt, me, np, minfo + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np + integer(psb_mpk_) :: icomm, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) @@ -701,7 +703,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ione*ictxt,err_act) +9999 call psb_error_handler(ictxt,err_act) return diff --git a/base/tools/psb_zfree.f90 b/base/tools/psb_zfree.f90 index cdb9d047..b544970b 100644 --- a/base/tools/psb_zfree.f90 +++ b/base/tools/psb_zfree.f90 @@ -46,7 +46,8 @@ subroutine psb_zfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -100,7 +101,8 @@ subroutine psb_zfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act, i + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -152,7 +154,8 @@ subroutine psb_zfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act character(len=20) :: name diff --git a/base/tools/psb_zfree_a.f90 b/base/tools/psb_zfree_a.f90 index 7dc6498e..c7bd6c00 100644 --- a/base/tools/psb_zfree_a.f90 +++ b/base/tools/psb_zfree_a.f90 @@ -48,7 +48,8 @@ subroutine psb_zfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_zfree' @@ -116,7 +117,8 @@ subroutine psb_zfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act character(len=20) :: name name='psb_zfreev' diff --git a/base/tools/psb_zgetelem.f90 b/base/tools/psb_zgetelem.f90 index 5e7e975f..030c62b8 100644 --- a/base/tools/psb_zgetelem.f90 +++ b/base/tools/psb_zgetelem.f90 @@ -55,7 +55,8 @@ function psb_z_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) character(len=20) :: name diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 8307434b..a5c1edb3 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -63,7 +63,8 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -190,7 +191,8 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) complex(psb_dpk_), allocatable :: lval(:) logical :: local_ @@ -295,7 +297,8 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -409,7 +412,8 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_zins_a.f90 b/base/tools/psb_zins_a.f90 index 7db797f8..19d5a869 100644 --- a/base/tools/psb_zins_a.f90 +++ b/base/tools/psb_zins_a.f90 @@ -68,7 +68,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np, me, dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -248,7 +249,8 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: ictxt,np,me,dupl_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index 81099dcb..84222f07 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -52,7 +52,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - integer(psb_ipk_) :: ictxt, np, me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n integer(psb_ipk_) :: debug_level, debug_unit diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 6cdfc61f..9ec41ecb 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -62,7 +62,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_z_base_sparse_mat), intent(in), optional :: mold !....Locals.... - integer(psb_ipk_) :: ictxt,np,me, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err diff --git a/base/tools/psb_zspfree.f90 b/base/tools/psb_zspfree.f90 index b002999d..01c1883e 100644 --- a/base/tools/psb_zspfree.f90 +++ b/base/tools/psb_zspfree.f90 @@ -48,7 +48,8 @@ subroutine psb_zspfree(a, desc_a,info) type(psb_zspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - integer(psb_ipk_) :: ictxt, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: err_act character(len=20) :: name info=psb_success_ diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index a862ce99..1021c726 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -90,7 +90,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -557,7 +558,8 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& & data_,totxch,nxs, nxr, ncg @@ -900,7 +902,8 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,nxs, nxr, err_act, nsnds, nrcvs @@ -1260,7 +1263,8 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - integer(psb_ipk_) :: ictxt, np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & data_,totxch,ngtz, idx, nxs, nxr, err_act, & diff --git a/base/tools/psb_zspins.F90 b/base/tools/psb_zspins.F90 index 6926bdc0..e9970ac5 100644 --- a/base/tools/psb_zspins.F90 +++ b/base/tools/psb_zspins.F90 @@ -64,7 +64,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -208,7 +209,8 @@ subroutine psb_zspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -306,7 +308,8 @@ subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ @@ -403,7 +406,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila(:),jla(:) @@ -518,7 +522,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 logical :: rebuild_, local_ diff --git a/base/tools/psb_zsprn.f90 b/base/tools/psb_zsprn.f90 index aa87a8f0..d7187f86 100644 --- a/base/tools/psb_zsprn.f90 +++ b/base/tools/psb_zsprn.f90 @@ -53,7 +53,8 @@ Subroutine psb_zsprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - integer(psb_ipk_) :: ictxt,np,me,err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name logical :: clear_ diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index 6d31778a..b102477a 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -33,6 +33,8 @@ contains type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (ng <=0) then @@ -50,7 +52,7 @@ contains allocate(descp,stat=info) if (info < 0) return - call psb_cdall(ictxt,descp,info,vg=vg(1:ng)) + call psb_cdall(ctxt,descp,info,vg=vg(1:ng)) cdh%item = c_loc(descp) res = info @@ -66,6 +68,8 @@ contains type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info, ixb + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (nl <=0) then @@ -86,9 +90,9 @@ contains ixb = psb_c_get_index_base() if (ixb == 1) then - call psb_cdall(ictxt,descp,info,vl=vl(1:nl)) + call psb_cdall(ctxt,descp,info,vl=vl(1:nl)) else - call psb_cdall(ictxt,descp,info,vl=(vl(1:nl)+(1-ixb))) + call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb))) end if cdh%item = c_loc(descp) res = info @@ -103,6 +107,8 @@ contains type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (nl <=0) then @@ -120,7 +126,7 @@ contains allocate(descp,stat=info) if (info < 0) return - call psb_cdall(ictxt,descp,info,nl=nl) + call psb_cdall(ctxt,descp,info,nl=nl) cdh%item = c_loc(descp) res = info @@ -135,6 +141,8 @@ contains type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (n <=0) then @@ -152,7 +160,7 @@ contains allocate(descp,stat=info) if (info < 0) return - call psb_cdall(ictxt,descp,info,mg=n,repl=.true.) + call psb_cdall(ctxt,descp,info,mg=n,repl=.true.) cdh%item = c_loc(descp) res = info @@ -301,7 +309,8 @@ contains end function psb_c_cd_get_global_cols - function psb_c_cd_get_global_indices(idx,nidx,owned,cdh) bind(c,name='psb_c_cd_get_global_indices') result(res) + function psb_c_cd_get_global_indices(idx,nidx,owned,cdh) & + & bind(c,name='psb_c_cd_get_global_indices') result(res) implicit none integer(psb_c_ipk_) :: res diff --git a/cbind/base/psb_cpenv_mod.f90 b/cbind/base/psb_cpenv_mod.f90 index ac311fa2..1814303d 100644 --- a/cbind/base/psb_cpenv_mod.f90 +++ b/cbind/base/psb_cpenv_mod.f90 @@ -22,7 +22,7 @@ contains end subroutine psb_c_set_index_base function psb_c_get_errstatus() bind(c) result(res) - use psb_base_mod, only : psb_get_errstatus + use psb_base_mod, only : psb_get_errstatus, psb_ctxt_type implicit none integer(psb_c_ipk_) :: res @@ -31,84 +31,101 @@ contains end function psb_c_get_errstatus function psb_c_init() bind(c) - use psb_base_mod, only : psb_init + use psb_base_mod, only : psb_init, psb_ctxt_type implicit none integer(psb_c_ipk_) :: psb_c_init - integer :: ictxt + type(psb_ctxt_type) :: ictxt call psb_init(ictxt) - psb_c_init = ictxt + psb_c_init = ictxt%ctxt end function psb_c_init subroutine psb_c_exit_ctxt(ictxt) bind(c) - use psb_base_mod, only : psb_exit + use psb_base_mod, only : psb_exit, psb_ctxt_type integer(psb_c_ipk_), value :: ictxt - - call psb_exit(ictxt,close=.false.) + + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + call psb_exit(ctxt,close=.false.) return end subroutine psb_c_exit_ctxt subroutine psb_c_exit(ictxt) bind(c) - use psb_base_mod, only : psb_exit + use psb_base_mod, only : psb_exit, psb_ctxt_type integer(psb_c_ipk_), value :: ictxt + + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt - call psb_exit(ictxt) + call psb_exit(ctxt) return end subroutine psb_c_exit subroutine psb_c_abort(ictxt) bind(c) - use psb_base_mod, only : psb_abort + use psb_base_mod, only : psb_abort, psb_ctxt_type integer(psb_c_ipk_), value :: ictxt - call psb_abort(ictxt) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + call psb_abort(ctxt) return end subroutine psb_c_abort subroutine psb_c_info(ictxt,iam,np) bind(c) - use psb_base_mod, only : psb_info + use psb_base_mod, only : psb_info, psb_ctxt_type integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_) :: iam,np - call psb_info(ictxt,iam,np) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + call psb_info(ctxt,iam,np) return end subroutine psb_c_info subroutine psb_c_barrier(ictxt) bind(c) - use psb_base_mod, only : psb_barrier + use psb_base_mod, only : psb_barrier, psb_ctxt_type integer(psb_c_ipk_), value :: ictxt - call psb_barrier(ictxt) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + call psb_barrier(ctxt) end subroutine psb_c_barrier real(c_double) function psb_c_wtime() bind(c) - use psb_base_mod, only : psb_wtime + use psb_base_mod, only : psb_wtime, psb_ctxt_type psb_c_wtime = psb_wtime() end function psb_c_wtime subroutine psb_c_mbcast(ictxt,n,v,root) bind(c) - use psb_base_mod, only : psb_bcast + use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_mpk_) :: v(*) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + if (n < 0) then write(0,*) 'Wrong size in BCAST' return end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_mbcast subroutine psb_c_ibcast(ictxt,n,v,root) bind(c) - use psb_base_mod, only : psb_bcast + use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_) :: v(*) + type(psb_ctxt_type) :: ctxt + + ctxt%ctxt = ictxt if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -116,37 +133,41 @@ contains end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_ibcast subroutine psb_c_lbcast(ictxt,n,v,root) bind(c) - use psb_base_mod, only : psb_bcast + use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_lpk_) :: v(*) - + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + if (n < 0) then write(0,*) 'Wrong size in BCAST' return end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_lbcast subroutine psb_c_ebcast(ictxt,n,v,root) bind(c) - use psb_base_mod, only : psb_bcast + use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_epk_) :: v(*) - + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt + if (n < 0) then write(0,*) 'Wrong size in BCAST' return end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_ebcast subroutine psb_c_sbcast(ictxt,n,v,root) bind(c) @@ -154,6 +175,8 @@ contains implicit none integer(psb_c_ipk_), value :: ictxt,n, root real(c_float) :: v(*) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -161,14 +184,16 @@ contains end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_sbcast subroutine psb_c_dbcast(ictxt,n,v,root) bind(c) - use psb_base_mod, only : psb_bcast + use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt,n, root real(c_double) :: v(*) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -176,15 +201,17 @@ contains end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_dbcast subroutine psb_c_cbcast(ictxt,n,v,root) bind(c) - use psb_base_mod, only : psb_bcast + use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt,n, root complex(c_float_complex) :: v(*) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -192,7 +219,7 @@ contains end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_cbcast subroutine psb_c_zbcast(ictxt,n,v,root) bind(c) @@ -200,6 +227,8 @@ contains implicit none integer(psb_c_ipk_), value :: ictxt,n, root complex(c_double_complex) :: v(*) + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -207,17 +236,19 @@ contains end if if (n==0) return - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_zbcast subroutine psb_c_hbcast(ictxt,v,root) bind(c) - use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_ + use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_, psb_ctxt_type implicit none integer(psb_c_ipk_), value :: ictxt, root character(c_char) :: v(*) integer(psb_ipk_) :: iam, np, n + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (iam==root) then n = 1 @@ -226,12 +257,12 @@ contains n = n + 1 end do end if - call psb_bcast(ictxt,n,root=root) - call psb_bcast(ictxt,v(1:n),root=root) + call psb_bcast(ctxt,n,root=root) + call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_hbcast function psb_c_f2c_errmsg(cmesg,len) bind(c) result(res) - use psb_base_mod, only : psb_errpop,psb_max_errmsg_len_ + use psb_base_mod, only : psb_errpop,psb_max_errmsg_len_, psb_ctxt_type use psb_base_string_cbind_mod implicit none character(c_char), intent(inout) :: cmesg(*) @@ -261,17 +292,17 @@ contains end function psb_c_f2c_errmsg subroutine psb_c_seterraction_ret() bind(c) - use psb_base_mod, only : psb_set_erraction, psb_act_ret_ + use psb_base_mod, only : psb_set_erraction, psb_act_ret_, psb_ctxt_type call psb_set_erraction(psb_act_ret_) end subroutine psb_c_seterraction_ret subroutine psb_c_seterraction_print() bind(c) - use psb_base_mod, only : psb_set_erraction, psb_act_print_ + use psb_base_mod, only : psb_set_erraction, psb_act_print_, psb_ctxt_type call psb_set_erraction(psb_act_print_) end subroutine psb_c_seterraction_print subroutine psb_c_seterraction_abort() bind(c) - use psb_base_mod, only : psb_set_erraction, psb_act_abort_ + use psb_base_mod, only : psb_set_erraction, psb_act_abort_, psb_ctxt_type call psb_set_erraction(psb_act_abort_) end subroutine psb_c_seterraction_abort diff --git a/cbind/prec/psb_cprec_cbind_mod.f90 b/cbind/prec/psb_cprec_cbind_mod.f90 index 94c34f16..25c545de 100644 --- a/cbind/prec/psb_cprec_cbind_mod.f90 +++ b/cbind/prec/psb_cprec_cbind_mod.f90 @@ -26,6 +26,8 @@ contains type(psb_cprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (c_associated(ph%item)) then @@ -38,7 +40,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(ictxt,precp,fptype,info) + call psb_precinit(ctxt,precp,fptype,info) res = min(0,info) return diff --git a/cbind/prec/psb_dprec_cbind_mod.f90 b/cbind/prec/psb_dprec_cbind_mod.f90 index d1625ad9..b311f890 100644 --- a/cbind/prec/psb_dprec_cbind_mod.f90 +++ b/cbind/prec/psb_dprec_cbind_mod.f90 @@ -26,6 +26,8 @@ contains type(psb_dprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (c_associated(ph%item)) then @@ -38,7 +40,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(ictxt,precp,fptype,info) + call psb_precinit(ctxt,precp,fptype,info) res = min(0,info) return diff --git a/cbind/prec/psb_sprec_cbind_mod.f90 b/cbind/prec/psb_sprec_cbind_mod.f90 index 5fb8a807..91854bcd 100644 --- a/cbind/prec/psb_sprec_cbind_mod.f90 +++ b/cbind/prec/psb_sprec_cbind_mod.f90 @@ -26,6 +26,8 @@ contains type(psb_sprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (c_associated(ph%item)) then @@ -38,7 +40,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(ictxt,precp,fptype,info) + call psb_precinit(ctxt,precp,fptype,info) res = min(0,info) return diff --git a/cbind/prec/psb_zprec_cbind_mod.f90 b/cbind/prec/psb_zprec_cbind_mod.f90 index 36755d23..15068ab0 100644 --- a/cbind/prec/psb_zprec_cbind_mod.f90 +++ b/cbind/prec/psb_zprec_cbind_mod.f90 @@ -26,6 +26,8 @@ contains type(psb_zprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype + type(psb_ctxt_type) :: ctxt + ctxt%ctxt = ictxt res = -1 if (c_associated(ph%item)) then @@ -38,7 +40,7 @@ contains call stringc2f(ptype,fptype) - call psb_precinit(ictxt,precp,fptype,info) + call psb_precinit(ctxt,precp,fptype,info) res = min(0,info) return diff --git a/krylov/psb_base_krylov_conv_mod.f90 b/krylov/psb_base_krylov_conv_mod.f90 index 5139157d..292e86ac 100644 --- a/krylov/psb_base_krylov_conv_mod.f90 +++ b/krylov/psb_base_krylov_conv_mod.f90 @@ -146,7 +146,8 @@ contains real(psb_dpk_), optional, intent(out) :: err integer(psb_ipk_), optional, intent(out) :: iter - integer(psb_ipk_) :: ictxt, me, np, err_act, itrace + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act, itrace real(psb_dpk_) :: errnum, errden, eps character(len=20) :: name diff --git a/krylov/psb_c_krylov_conv_mod.f90 b/krylov/psb_c_krylov_conv_mod.f90 index 0eb44aab..20f96e28 100644 --- a/krylov/psb_c_krylov_conv_mod.f90 +++ b/krylov/psb_c_krylov_conv_mod.f90 @@ -61,7 +61,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name complex(psb_spk_), allocatable :: r(:) @@ -134,7 +135,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ @@ -212,7 +214,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_c_vect_type) :: r @@ -284,7 +287,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index fbcc2d03..2f219782 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -123,7 +123,8 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_ccg.F90 b/krylov/psb_ccg.F90 index 41f64c77..7c855926 100644 --- a/krylov/psb_ccg.F90 +++ b/krylov/psb_ccg.F90 @@ -122,7 +122,8 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat logical :: do_cond diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index 240f98e6..bf4de563 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -117,7 +117,8 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr diff --git a/krylov/psb_ccgstab.f90 b/krylov/psb_ccgstab.f90 index c8c1709c..06e6bb24 100644 --- a/krylov/psb_ccgstab.f90 +++ b/krylov/psb_ccgstab.f90 @@ -121,7 +121,8 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma, omega, tau type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index 4c6dc896..2e829575 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -134,7 +134,8 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me complex(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega real(psb_dpk_) :: derr diff --git a/krylov/psb_cfcg.F90 b/krylov/psb_cfcg.F90 index 73b221d3..a90c4d67 100644 --- a/krylov/psb_cfcg.F90 +++ b/krylov/psb_cfcg.F90 @@ -128,7 +128,8 @@ subroutine psb_cfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me complex(psb_spk_), allocatable, target :: aux(:) complex(psb_spk_) :: vres(3) character(len=20) :: name diff --git a/krylov/psb_cgcr.f90 b/krylov/psb_cgcr.f90 index a59b15a1..82fb99c0 100644 --- a/krylov/psb_cgcr.f90 +++ b/krylov/psb_cgcr.f90 @@ -133,7 +133,8 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst complex(psb_spk_) :: hjj complex(psb_spk_), allocatable, target :: aux(:) diff --git a/krylov/psb_ckrylov.f90 b/krylov/psb_ckrylov.f90 index e9f12ea1..67702e5e 100644 --- a/krylov/psb_ckrylov.f90 +++ b/krylov/psb_ckrylov.f90 @@ -152,7 +152,8 @@ Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_ckryl_cond_vect) :: psb_ccg_vect, psb_cfcg_vect logical :: do_alloc_wrk - integer(psb_ipk_) :: ictxt,me,np,err_act, itrace_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index 9e20350f..1b062944 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -137,7 +137,8 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me Real(psb_spk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr character(len=20) :: name diff --git a/krylov/psb_d_krylov_conv_mod.f90 b/krylov/psb_d_krylov_conv_mod.f90 index d275bdbc..d0890584 100644 --- a/krylov/psb_d_krylov_conv_mod.f90 +++ b/krylov/psb_d_krylov_conv_mod.f90 @@ -61,7 +61,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name real(psb_dpk_), allocatable :: r(:) @@ -134,7 +135,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ @@ -212,7 +214,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_d_vect_type) :: r @@ -284,7 +287,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index abea8b86..3b81275b 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -123,7 +123,8 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index 2166ff39..94678aac 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -122,7 +122,8 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat logical :: do_cond diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index 0545483d..0fa922d6 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -117,7 +117,8 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr diff --git a/krylov/psb_dcgstab.f90 b/krylov/psb_dcgstab.f90 index 449e5511..27136ca2 100644 --- a/krylov/psb_dcgstab.f90 +++ b/krylov/psb_dcgstab.f90 @@ -121,7 +121,8 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index ca8a6fe0..2e8a895b 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -134,7 +134,8 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega real(psb_dpk_) :: derr diff --git a/krylov/psb_dfcg.F90 b/krylov/psb_dfcg.F90 index 990d70ec..22e1f2ee 100644 --- a/krylov/psb_dfcg.F90 +++ b/krylov/psb_dfcg.F90 @@ -128,7 +128,8 @@ subroutine psb_dfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_), allocatable, target :: aux(:) real(psb_dpk_) :: vres(3) character(len=20) :: name diff --git a/krylov/psb_dgcr.f90 b/krylov/psb_dgcr.f90 index 59c5e243..42c24b40 100644 --- a/krylov/psb_dgcr.f90 +++ b/krylov/psb_dgcr.f90 @@ -133,7 +133,8 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst real(psb_dpk_) :: hjj real(psb_dpk_), allocatable, target :: aux(:) diff --git a/krylov/psb_dkrylov.f90 b/krylov/psb_dkrylov.f90 index a1fe405a..2beb922c 100644 --- a/krylov/psb_dkrylov.f90 +++ b/krylov/psb_dkrylov.f90 @@ -152,7 +152,8 @@ Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_dkryl_cond_vect) :: psb_dcg_vect, psb_dfcg_vect logical :: do_alloc_wrk - integer(psb_ipk_) :: ictxt,me,np,err_act, itrace_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index f30b3391..0e2a3ef7 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -137,7 +137,8 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me Real(psb_dpk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr character(len=20) :: name diff --git a/krylov/psb_s_krylov_conv_mod.f90 b/krylov/psb_s_krylov_conv_mod.f90 index ede2eb75..19d84930 100644 --- a/krylov/psb_s_krylov_conv_mod.f90 +++ b/krylov/psb_s_krylov_conv_mod.f90 @@ -61,7 +61,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name real(psb_spk_), allocatable :: r(:) @@ -134,7 +135,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ @@ -212,7 +214,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_s_vect_type) :: r @@ -284,7 +287,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_sbicg.f90 b/krylov/psb_sbicg.f90 index f5f54387..ee2b0cf4 100644 --- a/krylov/psb_sbicg.f90 +++ b/krylov/psb_sbicg.f90 @@ -123,7 +123,8 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_spk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_scg.F90 b/krylov/psb_scg.F90 index cbb41e3b..2df33788 100644 --- a/krylov/psb_scg.F90 +++ b/krylov/psb_scg.F90 @@ -122,7 +122,8 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat logical :: do_cond diff --git a/krylov/psb_scgs.f90 b/krylov/psb_scgs.f90 index b45d6b9d..40095ff6 100644 --- a/krylov/psb_scgs.f90 +++ b/krylov/psb_scgs.f90 @@ -117,7 +117,8 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit real(psb_spk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr diff --git a/krylov/psb_scgstab.f90 b/krylov/psb_scgstab.f90 index 62eb965a..ecb1de1b 100644 --- a/krylov/psb_scgstab.f90 +++ b/krylov/psb_scgstab.f90 @@ -121,7 +121,8 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr real(psb_spk_) :: alpha, beta, rho, rho_old, sigma, omega, tau type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_scgstabl.f90 b/krylov/psb_scgstabl.f90 index 5c53781d..ea5d26b1 100644 --- a/krylov/psb_scgstabl.f90 +++ b/krylov/psb_scgstabl.f90 @@ -134,7 +134,8 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega real(psb_dpk_) :: derr diff --git a/krylov/psb_sfcg.F90 b/krylov/psb_sfcg.F90 index 6c233f0e..67685c98 100644 --- a/krylov/psb_sfcg.F90 +++ b/krylov/psb_sfcg.F90 @@ -128,7 +128,8 @@ subroutine psb_sfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_spk_), allocatable, target :: aux(:) real(psb_spk_) :: vres(3) character(len=20) :: name diff --git a/krylov/psb_sgcr.f90 b/krylov/psb_sgcr.f90 index ce11c389..b26cf80e 100644 --- a/krylov/psb_sgcr.f90 +++ b/krylov/psb_sgcr.f90 @@ -133,7 +133,8 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst real(psb_spk_) :: hjj real(psb_spk_), allocatable, target :: aux(:) diff --git a/krylov/psb_skrylov.f90 b/krylov/psb_skrylov.f90 index e2c02732..38a1ae77 100644 --- a/krylov/psb_skrylov.f90 +++ b/krylov/psb_skrylov.f90 @@ -152,7 +152,8 @@ Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_skryl_cond_vect) :: psb_scg_vect, psb_sfcg_vect logical :: do_alloc_wrk - integer(psb_ipk_) :: ictxt,me,np,err_act, itrace_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index f6443c30..b7ae8d08 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -137,7 +137,8 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me Real(psb_spk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr character(len=20) :: name diff --git a/krylov/psb_z_krylov_conv_mod.f90 b/krylov/psb_z_krylov_conv_mod.f90 index 333dd031..af236e54 100644 --- a/krylov/psb_z_krylov_conv_mod.f90 +++ b/krylov/psb_z_krylov_conv_mod.f90 @@ -61,7 +61,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name complex(psb_dpk_), allocatable :: r(:) @@ -134,7 +135,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ @@ -212,7 +214,8 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_z_vect_type) :: r @@ -284,7 +287,8 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: ictxt, me, np, err_act + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me, np, err_act character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_zbicg.f90 b/krylov/psb_zbicg.f90 index d216c93c..223e6998 100644 --- a/krylov/psb_zbicg.f90 +++ b/krylov/psb_zbicg.f90 @@ -123,7 +123,8 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_zcg.F90 b/krylov/psb_zcg.F90 index f89764ce..66f3fdbe 100644 --- a/krylov/psb_zcg.F90 +++ b/krylov/psb_zcg.F90 @@ -122,7 +122,8 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat logical :: do_cond diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index c4091428..2a245980 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -117,7 +117,8 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr diff --git a/krylov/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 index 4fca5c03..e6060d1b 100644 --- a/krylov/psb_zcgstab.f90 +++ b/krylov/psb_zcgstab.f90 @@ -121,7 +121,8 @@ Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau type(psb_itconv_type) :: stopdat diff --git a/krylov/psb_zcgstabl.f90 b/krylov/psb_zcgstabl.f90 index bcb4b652..e2421e98 100644 --- a/krylov/psb_zcgstabl.f90 +++ b/krylov/psb_zcgstabl.f90 @@ -134,7 +134,8 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me complex(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega real(psb_dpk_) :: derr diff --git a/krylov/psb_zfcg.F90 b/krylov/psb_zfcg.F90 index 14ecc985..21f1d3cb 100644 --- a/krylov/psb_zfcg.F90 +++ b/krylov/psb_zfcg.F90 @@ -128,7 +128,8 @@ subroutine psb_zfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me complex(psb_dpk_), allocatable, target :: aux(:) complex(psb_dpk_) :: vres(3) character(len=20) :: name diff --git a/krylov/psb_zgcr.f90 b/krylov/psb_zgcr.f90 index c40f2166..a8a05268 100644 --- a/krylov/psb_zgcr.f90 +++ b/krylov/psb_zgcr.f90 @@ -133,7 +133,8 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: np, me, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst complex(psb_dpk_) :: hjj complex(psb_dpk_), allocatable, target :: aux(:) diff --git a/krylov/psb_zkrylov.f90 b/krylov/psb_zkrylov.f90 index 48371920..34344407 100644 --- a/krylov/psb_zkrylov.f90 +++ b/krylov/psb_zkrylov.f90 @@ -152,7 +152,8 @@ Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_zkryl_cond_vect) :: psb_zcg_vect, psb_zfcg_vect logical :: do_alloc_wrk - integer(psb_ipk_) :: ictxt,me,np,err_act, itrace_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name info = psb_success_ diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index 73d7f08b..fefefa5e 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -137,7 +137,8 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt, np, me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np, me Real(psb_dpk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr character(len=20) :: name diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index de453684..de0a57e5 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_c_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -87,7 +88,8 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:) type(psb_c_vect_type) :: wv, wv1 - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit logical :: do_alloc_wrk @@ -242,7 +244,8 @@ subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit character :: trans_ @@ -432,7 +435,8 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_c_csr_sparse_mat), allocatable :: lf, uf complex(psb_spk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me character(len=20) :: name='c_bjac_precbld' character(len=20) :: ch_err diff --git a/prec/impl/psb_c_diagprec_impl.f90 b/prec/impl/psb_c_diagprec_impl.f90 index f31aae1e..6ad7586d 100644 --- a/prec/impl/psb_c_diagprec_impl.f90 +++ b/prec/impl/psb_c_diagprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_c_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/impl/psb_c_prec_type_impl.f90 b/prec/impl/psb_c_prec_type_impl.f90 index e1f13fc4..5858df0b 100644 --- a/prec/impl/psb_c_prec_type_impl.f90 +++ b/prec/impl/psb_c_prec_type_impl.f90 @@ -76,7 +76,8 @@ subroutine psb_c_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_spk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -146,7 +147,8 @@ subroutine psb_c_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_c_vect_type) :: ww character :: trans_ complex(psb_spk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -218,7 +220,8 @@ subroutine psb_c_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_spk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -282,7 +285,8 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act complex(psb_spk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -291,7 +295,7 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt=desc_data%get_context() + ictxt = desc_data%get_context() call psb_info(ictxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) diff --git a/prec/impl/psb_cprecbld.f90 b/prec/impl/psb_cprecbld.f90 index 588ac84d..39d16bd8 100644 --- a/prec/impl/psb_cprecbld.f90 +++ b/prec/impl/psb_cprecbld.f90 @@ -44,7 +44,8 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - integer(psb_ipk_) :: ictxt, me,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err diff --git a/prec/impl/psb_cprecinit.f90 b/prec/impl/psb_cprecinit.f90 index 9f0b4d68..ace7fea3 100644 --- a/prec/impl/psb_cprecinit.f90 +++ b/prec/impl/psb_cprecinit.f90 @@ -37,7 +37,7 @@ subroutine psb_cprecinit(ictxt,p,ptype,info) use psb_c_diagprec, only : psb_c_diag_prec_type use psb_c_bjacprec, only : psb_c_bjac_prec_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_cprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index ef8c52c3..b8643385 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_d_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -87,7 +88,8 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:) type(psb_d_vect_type) :: wv, wv1 - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit logical :: do_alloc_wrk @@ -242,7 +244,8 @@ subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit character :: trans_ @@ -432,7 +435,8 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_d_csr_sparse_mat), allocatable :: lf, uf real(psb_dpk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me character(len=20) :: name='d_bjac_precbld' character(len=20) :: ch_err diff --git a/prec/impl/psb_d_diagprec_impl.f90 b/prec/impl/psb_d_diagprec_impl.f90 index 5e0175a2..4c0d4937 100644 --- a/prec/impl/psb_d_diagprec_impl.f90 +++ b/prec/impl/psb_d_diagprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_d_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/impl/psb_d_prec_type_impl.f90 b/prec/impl/psb_d_prec_type_impl.f90 index 793afac7..2dead542 100644 --- a/prec/impl/psb_d_prec_type_impl.f90 +++ b/prec/impl/psb_d_prec_type_impl.f90 @@ -76,7 +76,8 @@ subroutine psb_d_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_dpk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -146,7 +147,8 @@ subroutine psb_d_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_d_vect_type) :: ww character :: trans_ real(psb_dpk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -218,7 +220,8 @@ subroutine psb_d_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_dpk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -282,7 +285,8 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act real(psb_dpk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -291,7 +295,7 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt=desc_data%get_context() + ictxt = desc_data%get_context() call psb_info(ictxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) diff --git a/prec/impl/psb_dprecbld.f90 b/prec/impl/psb_dprecbld.f90 index dc3d7585..f3cef96a 100644 --- a/prec/impl/psb_dprecbld.f90 +++ b/prec/impl/psb_dprecbld.f90 @@ -44,7 +44,8 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - integer(psb_ipk_) :: ictxt, me,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err diff --git a/prec/impl/psb_dprecinit.f90 b/prec/impl/psb_dprecinit.f90 index f28bd446..771a1c21 100644 --- a/prec/impl/psb_dprecinit.f90 +++ b/prec/impl/psb_dprecinit.f90 @@ -37,7 +37,7 @@ subroutine psb_dprecinit(ictxt,p,ptype,info) use psb_d_diagprec, only : psb_d_diag_prec_type use psb_d_bjacprec, only : psb_d_bjac_prec_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_dprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index 3a9cfce2..7903eda0 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_s_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -87,7 +88,8 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:) type(psb_s_vect_type) :: wv, wv1 - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit logical :: do_alloc_wrk @@ -242,7 +244,8 @@ subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit character :: trans_ @@ -432,7 +435,8 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_s_csr_sparse_mat), allocatable :: lf, uf real(psb_spk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me character(len=20) :: name='s_bjac_precbld' character(len=20) :: ch_err diff --git a/prec/impl/psb_s_diagprec_impl.f90 b/prec/impl/psb_s_diagprec_impl.f90 index 79ba27cc..b463bfdb 100644 --- a/prec/impl/psb_s_diagprec_impl.f90 +++ b/prec/impl/psb_s_diagprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_s_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/impl/psb_s_prec_type_impl.f90 b/prec/impl/psb_s_prec_type_impl.f90 index 547272a0..36e0ccbc 100644 --- a/prec/impl/psb_s_prec_type_impl.f90 +++ b/prec/impl/psb_s_prec_type_impl.f90 @@ -76,7 +76,8 @@ subroutine psb_s_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_spk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -146,7 +147,8 @@ subroutine psb_s_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_s_vect_type) :: ww character :: trans_ real(psb_spk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -218,7 +220,8 @@ subroutine psb_s_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_spk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -282,7 +285,8 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act real(psb_spk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -291,7 +295,7 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt=desc_data%get_context() + ictxt = desc_data%get_context() call psb_info(ictxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) diff --git a/prec/impl/psb_sprecbld.f90 b/prec/impl/psb_sprecbld.f90 index 8cc48eab..7e67fe05 100644 --- a/prec/impl/psb_sprecbld.f90 +++ b/prec/impl/psb_sprecbld.f90 @@ -44,7 +44,8 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - integer(psb_ipk_) :: ictxt, me,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err diff --git a/prec/impl/psb_sprecinit.f90 b/prec/impl/psb_sprecinit.f90 index fa5b83c2..b7924628 100644 --- a/prec/impl/psb_sprecinit.f90 +++ b/prec/impl/psb_sprecinit.f90 @@ -37,7 +37,7 @@ subroutine psb_sprecinit(ictxt,p,ptype,info) use psb_s_diagprec, only : psb_s_diag_prec_type use psb_s_bjacprec, only : psb_s_bjac_prec_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_sprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index b70018f4..e0265ecb 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_z_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -87,7 +88,8 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:) type(psb_z_vect_type) :: wv, wv1 - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit logical :: do_alloc_wrk @@ -242,7 +244,8 @@ subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit character :: trans_ @@ -432,7 +435,8 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_z_csr_sparse_mat), allocatable :: lf, uf complex(psb_dpk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me character(len=20) :: name='z_bjac_precbld' character(len=20) :: ch_err diff --git a/prec/impl/psb_z_diagprec_impl.f90 b/prec/impl/psb_z_diagprec_impl.f90 index 24e288f5..a70d6492 100644 --- a/prec/impl/psb_z_diagprec_impl.f90 +++ b/prec/impl/psb_z_diagprec_impl.f90 @@ -38,7 +38,8 @@ subroutine psb_z_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_ipk_) :: ictxt,iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/impl/psb_z_prec_type_impl.f90 b/prec/impl/psb_z_prec_type_impl.f90 index 982fc008..8b25f94e 100644 --- a/prec/impl/psb_z_prec_type_impl.f90 +++ b/prec/impl/psb_z_prec_type_impl.f90 @@ -76,7 +76,8 @@ subroutine psb_z_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_dpk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -146,7 +147,8 @@ subroutine psb_z_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_z_vect_type) :: ww character :: trans_ complex(psb_dpk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -218,7 +220,8 @@ subroutine psb_z_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_dpk_), pointer :: work_(:) - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -282,7 +285,8 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - integer(psb_ipk_) :: ictxt,np,me + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act complex(psb_dpk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -291,7 +295,7 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt=desc_data%get_context() + ictxt = desc_data%get_context() call psb_info(ictxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) diff --git a/prec/impl/psb_zprecbld.f90 b/prec/impl/psb_zprecbld.f90 index b99cfe92..dbe33611 100644 --- a/prec/impl/psb_zprecbld.f90 +++ b/prec/impl/psb_zprecbld.f90 @@ -44,7 +44,8 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - integer(psb_ipk_) :: ictxt, me,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 character(len=20) :: name, ch_err diff --git a/prec/impl/psb_zprecinit.f90 b/prec/impl/psb_zprecinit.f90 index d9f5aa01..5f9556d3 100644 --- a/prec/impl/psb_zprecinit.f90 +++ b/prec/impl/psb_zprecinit.f90 @@ -37,7 +37,7 @@ subroutine psb_zprecinit(ictxt,p,ptype,info) use psb_z_diagprec, only : psb_z_diag_prec_type use psb_z_bjacprec, only : psb_z_bjac_prec_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_zprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_c_base_prec_mod.f90 b/prec/psb_c_base_prec_mod.f90 index 8b453241..62c997aa 100644 --- a/prec/psb_c_base_prec_mod.f90 +++ b/prec/psb_c_base_prec_mod.f90 @@ -36,17 +36,18 @@ module psb_c_base_prec_mod ! Reduces size of .mod file. - use psb_base_mod, only : psb_spk_, psb_ipk_, psb_epk_,& + use psb_base_mod, only : psb_spk_, psb_ipk_, psb_epk_, psb_ctxt_type, & & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, & + & psb_errstatus_fatal, psb_success_,& & psb_c_base_sparse_mat, psb_cspmat_type, psb_c_csr_sparse_mat,& & psb_c_base_vect_type, psb_c_vect_type, psb_i_base_vect_type use psb_prec_const_mod type, abstract :: psb_c_base_prec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt contains procedure, pass(prec) :: set_ctxt => psb_c_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_c_base_get_ctxt @@ -345,7 +346,7 @@ contains subroutine psb_c_base_set_ctxt(prec,ictxt) implicit none class(psb_c_base_prec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type) :: ictxt prec%ictxt = ictxt @@ -361,7 +362,7 @@ contains function psb_c_base_get_ctxt(prec) result(val) class(psb_c_base_prec_type), intent(in) :: prec - integer(psb_ipk_) :: val + type(psb_ctxt_type) :: val val = prec%ictxt return @@ -382,7 +383,8 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - integer(psb_ipk_) :: ni, ictxt,iam,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: ni, iam, np ictxt = prec%ictxt call psb_info(ictxt,iam,np) diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index 2a46a6df..67cee500 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -148,7 +148,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='c_bjac_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_c_diagprec.f90 b/prec/psb_c_diagprec.f90 index f2eaa4d0..cedcf0c4 100644 --- a/prec/psb_c_diagprec.f90 +++ b/prec/psb_c_diagprec.f90 @@ -171,7 +171,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='c_diag_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_c_nullprec.f90 b/prec/psb_c_nullprec.f90 index 9a75366e..7130679a 100644 --- a/prec/psb_c_nullprec.f90 +++ b/prec/psb_c_nullprec.f90 @@ -170,7 +170,8 @@ contains character(len=20) :: name='c_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -212,7 +213,8 @@ contains class(psb_c_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - integer(psb_ipk_) :: iout, iam, np, ictxt, lname + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 6d9aa908..4314b672 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -39,7 +39,7 @@ module psb_c_prec_type use psb_c_base_prec_mod type psb_cprec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt class(psb_c_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_c_apply1_vect @@ -65,9 +65,9 @@ module psb_c_prec_type interface psb_precinit subroutine psb_cprecinit(ictxt,prec,ptype,info) - import :: psb_ipk_, psb_cprec_type + import :: psb_ipk_, psb_cprec_type, psb_ctxt_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_cprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_d_base_prec_mod.f90 b/prec/psb_d_base_prec_mod.f90 index dc39ca70..59689197 100644 --- a/prec/psb_d_base_prec_mod.f90 +++ b/prec/psb_d_base_prec_mod.f90 @@ -36,17 +36,18 @@ module psb_d_base_prec_mod ! Reduces size of .mod file. - use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_epk_,& + use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_epk_, psb_ctxt_type, & & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, & + & psb_errstatus_fatal, psb_success_,& & psb_d_base_sparse_mat, psb_dspmat_type, psb_d_csr_sparse_mat,& & psb_d_base_vect_type, psb_d_vect_type, psb_i_base_vect_type use psb_prec_const_mod type, abstract :: psb_d_base_prec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt contains procedure, pass(prec) :: set_ctxt => psb_d_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_d_base_get_ctxt @@ -345,7 +346,7 @@ contains subroutine psb_d_base_set_ctxt(prec,ictxt) implicit none class(psb_d_base_prec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type) :: ictxt prec%ictxt = ictxt @@ -361,7 +362,7 @@ contains function psb_d_base_get_ctxt(prec) result(val) class(psb_d_base_prec_type), intent(in) :: prec - integer(psb_ipk_) :: val + type(psb_ctxt_type) :: val val = prec%ictxt return @@ -382,7 +383,8 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - integer(psb_ipk_) :: ni, ictxt,iam,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: ni, iam, np ictxt = prec%ictxt call psb_info(ictxt,iam,np) diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 06279ae1..1ca350ce 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -148,7 +148,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='d_bjac_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index 4bdda8bc..36e49247 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -171,7 +171,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='d_diag_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_d_nullprec.f90 b/prec/psb_d_nullprec.f90 index 421c59ef..4b8f22a5 100644 --- a/prec/psb_d_nullprec.f90 +++ b/prec/psb_d_nullprec.f90 @@ -170,7 +170,8 @@ contains character(len=20) :: name='d_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -212,7 +213,8 @@ contains class(psb_d_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - integer(psb_ipk_) :: iout, iam, np, ictxt, lname + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index f50339a3..322fade3 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -39,7 +39,7 @@ module psb_d_prec_type use psb_d_base_prec_mod type psb_dprec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt class(psb_d_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_d_apply1_vect @@ -65,9 +65,9 @@ module psb_d_prec_type interface psb_precinit subroutine psb_dprecinit(ictxt,prec,ptype,info) - import :: psb_ipk_, psb_dprec_type + import :: psb_ipk_, psb_dprec_type, psb_ctxt_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_dprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_s_base_prec_mod.f90 b/prec/psb_s_base_prec_mod.f90 index b2a89f06..35bcc785 100644 --- a/prec/psb_s_base_prec_mod.f90 +++ b/prec/psb_s_base_prec_mod.f90 @@ -36,17 +36,18 @@ module psb_s_base_prec_mod ! Reduces size of .mod file. - use psb_base_mod, only : psb_spk_, psb_ipk_, psb_epk_,& + use psb_base_mod, only : psb_spk_, psb_ipk_, psb_epk_, psb_ctxt_type, & & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, & + & psb_errstatus_fatal, psb_success_,& & psb_s_base_sparse_mat, psb_sspmat_type, psb_s_csr_sparse_mat,& & psb_s_base_vect_type, psb_s_vect_type, psb_i_base_vect_type use psb_prec_const_mod type, abstract :: psb_s_base_prec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt contains procedure, pass(prec) :: set_ctxt => psb_s_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_s_base_get_ctxt @@ -345,7 +346,7 @@ contains subroutine psb_s_base_set_ctxt(prec,ictxt) implicit none class(psb_s_base_prec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type) :: ictxt prec%ictxt = ictxt @@ -361,7 +362,7 @@ contains function psb_s_base_get_ctxt(prec) result(val) class(psb_s_base_prec_type), intent(in) :: prec - integer(psb_ipk_) :: val + type(psb_ctxt_type) :: val val = prec%ictxt return @@ -382,7 +383,8 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - integer(psb_ipk_) :: ni, ictxt,iam,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: ni, iam, np ictxt = prec%ictxt call psb_info(ictxt,iam,np) diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 25ad7642..6d404d47 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -148,7 +148,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='s_bjac_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_s_diagprec.f90 b/prec/psb_s_diagprec.f90 index 56c3c458..6807ae48 100644 --- a/prec/psb_s_diagprec.f90 +++ b/prec/psb_s_diagprec.f90 @@ -171,7 +171,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='s_diag_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_s_nullprec.f90 b/prec/psb_s_nullprec.f90 index 06e31251..c7ad6ee9 100644 --- a/prec/psb_s_nullprec.f90 +++ b/prec/psb_s_nullprec.f90 @@ -170,7 +170,8 @@ contains character(len=20) :: name='s_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -212,7 +213,8 @@ contains class(psb_s_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - integer(psb_ipk_) :: iout, iam, np, ictxt, lname + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index ded50ca4..b59e71a5 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -39,7 +39,7 @@ module psb_s_prec_type use psb_s_base_prec_mod type psb_sprec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt class(psb_s_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_s_apply1_vect @@ -65,9 +65,9 @@ module psb_s_prec_type interface psb_precinit subroutine psb_sprecinit(ictxt,prec,ptype,info) - import :: psb_ipk_, psb_sprec_type + import :: psb_ipk_, psb_sprec_type, psb_ctxt_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_sprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_z_base_prec_mod.f90 b/prec/psb_z_base_prec_mod.f90 index a1e832f4..79c185a3 100644 --- a/prec/psb_z_base_prec_mod.f90 +++ b/prec/psb_z_base_prec_mod.f90 @@ -36,17 +36,18 @@ module psb_z_base_prec_mod ! Reduces size of .mod file. - use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_epk_,& + use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_epk_, psb_ctxt_type, & & psb_desc_type, psb_sizeof, psb_free, psb_cdfree, psb_errpush, psb_act_abort_,& & psb_sizeof_ip, psb_sizeof_lp, psb_sizeof_sp, psb_sizeof_dp, & - & psb_erractionsave, psb_erractionrestore, psb_error, psb_errstatus_fatal, psb_success_,& + & psb_erractionsave, psb_erractionrestore, psb_error, & + & psb_errstatus_fatal, psb_success_,& & psb_z_base_sparse_mat, psb_zspmat_type, psb_z_csr_sparse_mat,& & psb_z_base_vect_type, psb_z_vect_type, psb_i_base_vect_type use psb_prec_const_mod type, abstract :: psb_z_base_prec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt contains procedure, pass(prec) :: set_ctxt => psb_z_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_z_base_get_ctxt @@ -345,7 +346,7 @@ contains subroutine psb_z_base_set_ctxt(prec,ictxt) implicit none class(psb_z_base_prec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type) :: ictxt prec%ictxt = ictxt @@ -361,7 +362,7 @@ contains function psb_z_base_get_ctxt(prec) result(val) class(psb_z_base_prec_type), intent(in) :: prec - integer(psb_ipk_) :: val + type(psb_ctxt_type) :: val val = prec%ictxt return @@ -382,7 +383,8 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - integer(psb_ipk_) :: ni, ictxt,iam,np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: ni, iam, np ictxt = prec%ictxt call psb_info(ictxt,iam,np) diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index 8ca5616a..853358fe 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -148,7 +148,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='z_bjac_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_z_diagprec.f90 b/prec/psb_z_diagprec.f90 index 5201989d..957d6357 100644 --- a/prec/psb_z_diagprec.f90 +++ b/prec/psb_z_diagprec.f90 @@ -171,7 +171,8 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='z_diag_precdescr' - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) diff --git a/prec/psb_z_nullprec.f90 b/prec/psb_z_nullprec.f90 index 7c0d26ff..9343bcc2 100644 --- a/prec/psb_z_nullprec.f90 +++ b/prec/psb_z_nullprec.f90 @@ -170,7 +170,8 @@ contains character(len=20) :: name='z_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - integer(psb_ipk_) :: iout_, ictxt, iam, np, root_ + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -212,7 +213,8 @@ contains class(psb_z_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - integer(psb_ipk_) :: iout, iam, np, ictxt, lname + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index 8b1a8f4b..48243b29 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -39,7 +39,7 @@ module psb_z_prec_type use psb_z_base_prec_mod type psb_zprec_type - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt class(psb_z_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_z_apply1_vect @@ -65,9 +65,9 @@ module psb_z_prec_type interface psb_precinit subroutine psb_zprecinit(ictxt,prec,ptype,info) - import :: psb_ipk_, psb_zprec_type + import :: psb_ipk_, psb_zprec_type, psb_ctxt_type implicit none - integer(psb_ipk_), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ictxt class(psb_zprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/test/cdasb/psb_d_pde3d.f90 b/test/cdasb/psb_d_pde3d.f90 index c14f8446..fa23602f 100644 --- a/test/cdasb/psb_d_pde3d.f90 +++ b/test/cdasb/psb_d_pde3d.f90 @@ -192,7 +192,8 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f class(psb_d_base_sparse_mat), optional :: amold @@ -641,7 +642,8 @@ program psb_d_pde3d ! dense vectors type(psb_d_vect_type) :: xxv,bv ! parallel environment - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, ipart @@ -722,7 +724,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam diff --git a/test/fileread/getp.f90 b/test/fileread/getp.f90 index e9ddf7d2..5dc39d4e 100644 --- a/test/fileread/getp.f90 +++ b/test/fileread/getp.f90 @@ -41,7 +41,7 @@ contains subroutine get_dparms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,& & afmt,istopc,itmax,itrace,irst,eps) use psb_base_mod - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=2) :: filefmt character(len=40) :: kmethd, mtrx_file, rhs_file, ptype character(len=20) :: part @@ -161,7 +161,7 @@ contains subroutine get_sparms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,& & afmt,istopc,itmax,itrace,irst,eps) use psb_base_mod - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=2) :: filefmt character(len=40) :: kmethd, mtrx_file, rhs_file, ptype character(len=20) :: part diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index d340c90d..25f8533c 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -56,7 +56,8 @@ program psb_cf_sample ! communications data structure type(psb_desc_type):: desc_a - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,& diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index d0665723..8c7f56d2 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -56,7 +56,8 @@ program psb_df_sample ! communications data structure type(psb_desc_type):: desc_a - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,& diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index 2801c178..cf49b1a6 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -56,7 +56,8 @@ program psb_sf_sample ! communications data structure type(psb_desc_type):: desc_a - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,& diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index c327a80b..58028532 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -56,7 +56,8 @@ program psb_zf_sample ! communications data structure type(psb_desc_type):: desc_a - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,& diff --git a/test/hello/hello.f90 b/test/hello/hello.f90 index 2a07dba3..9f28e211 100644 --- a/test/hello/hello.f90 +++ b/test/hello/hello.f90 @@ -1,7 +1,8 @@ program hello use psb_base_mod implicit none - integer(psb_ipk_) :: iam, np, icontxt, ip, jp, idummy + type(psb_ctxt_type) :: icontxt + integer(psb_ipk_) :: iam, np, ip, jp, idummy call psb_init(icontxt) call psb_info(icontxt,iam,np) diff --git a/test/hello/pingpong.f90 b/test/hello/pingpong.f90 index b6a53c2f..ba0cbb77 100644 --- a/test/hello/pingpong.f90 +++ b/test/hello/pingpong.f90 @@ -1,7 +1,8 @@ program pingpong use psb_base_mod implicit none - integer(psb_ipk_) :: iam, np, icontxt, ip, jp, idummy + type(psb_ctxt_type) :: icontxt + integer(psb_ipk_) :: iam, np, ip, jp, idummy integer(psb_ipk_), parameter :: nmax=2**16 integer(psb_ipk_) :: i,j,k,n real(psb_dpk_) :: v(nmax) diff --git a/test/kernel/d_file_spmv.f90 b/test/kernel/d_file_spmv.f90 index bc4bb38d..f7bb3932 100644 --- a/test/kernel/d_file_spmv.f90 +++ b/test/kernel/d_file_spmv.f90 @@ -51,7 +51,8 @@ program d_file_spmv ! communications data structure type(psb_desc_type):: desc_a - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver paramters integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& diff --git a/test/kernel/pdgenspmv.f90 b/test/kernel/pdgenspmv.f90 index 1a59902f..aaf16fe6 100644 --- a/test/kernel/pdgenspmv.f90 +++ b/test/kernel/pdgenspmv.f90 @@ -165,7 +165,8 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f class(psb_d_base_sparse_mat), optional :: amold @@ -567,7 +568,8 @@ program pdgenspmv type(psb_d_vect_type) :: xv,bv, vtst real(psb_dpk_), allocatable :: tst(:) ! blacs parameters - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nr, ipart @@ -720,7 +722,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,afmt,idim) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=*) :: afmt integer(psb_ipk_) :: idim integer(psb_ipk_) :: np, iam diff --git a/test/kernel/s_file_spmv.f90 b/test/kernel/s_file_spmv.f90 index 68decacd..4675a5d5 100644 --- a/test/kernel/s_file_spmv.f90 +++ b/test/kernel/s_file_spmv.f90 @@ -50,7 +50,8 @@ program s_file_spmv ! communications data structure type(psb_desc_type):: desc_a - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver paramters integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& diff --git a/test/kernel/vecoperation.f90 b/test/kernel/vecoperation.f90 index 0b73ff15..139364aa 100644 --- a/test/kernel/vecoperation.f90 +++ b/test/kernel/vecoperation.f90 @@ -34,7 +34,7 @@ module unittestvector_mod use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_desc_type,& - & psb_dspmat_type, psb_d_vect_type, dzero,& + & psb_dspmat_type, psb_d_vect_type, dzero, psb_ctxt_type,& & psb_d_base_sparse_mat, psb_d_base_vect_type, psb_i_base_vect_type interface psb_gen_const @@ -50,7 +50,7 @@ contains type(psb_d_vect_type) :: v real(psb_dpk_) :: val - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt logical :: ans ! Local variables @@ -84,7 +84,8 @@ contains type(psb_d_vect_type) :: v type(psb_desc_type) :: desc_a integer(psb_lpk_) :: idim - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info real(psb_dpk_) :: val ! Local variables @@ -184,7 +185,8 @@ program vecoperation ! vector type(psb_d_vect_type) :: x,y,z ! blacs parameters - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! auxiliary parameters integer(psb_ipk_) :: info character(len=20) :: name,ch_err,readinput diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index 4b8b6584..51a4e7d1 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -176,7 +176,8 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_2d), optional :: f class(psb_d_base_sparse_mat), optional :: amold @@ -556,7 +557,8 @@ program psb_d_pde2d ! dense vectors type(psb_d_vect_type) :: xxv,bv ! parallel environment - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, ipart @@ -705,7 +707,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index 429e9a0e..4080ab9a 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -192,7 +192,8 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f class(psb_d_base_sparse_mat), optional :: amold @@ -597,7 +598,8 @@ program psb_d_pde3d ! dense vectors type(psb_d_vect_type) :: xxv,bv ! parallel environment - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, ipart @@ -746,7 +748,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index b0fe9a7e..2a79da53 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -176,7 +176,8 @@ contains type(psb_sspmat_type) :: a type(psb_s_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(s_func_2d), optional :: f class(psb_s_base_sparse_mat), optional :: amold @@ -556,7 +557,8 @@ program psb_s_pde2d ! dense vectors type(psb_s_vect_type) :: xxv,bv ! parallel environment - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, ipart @@ -705,7 +707,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index e7c7725e..da1d65f1 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -192,7 +192,8 @@ contains type(psb_sspmat_type) :: a type(psb_s_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(s_func_3d), optional :: f class(psb_s_base_sparse_mat), optional :: amold @@ -597,7 +598,8 @@ program psb_s_pde3d ! dense vectors type(psb_s_vect_type) :: xxv,bv ! parallel environment - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, ipart @@ -746,7 +748,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam diff --git a/test/serial/d_matgen.F90 b/test/serial/d_matgen.F90 index ab41f790..e96a1de9 100644 --- a/test/serial/d_matgen.F90 +++ b/test/serial/d_matgen.F90 @@ -58,7 +58,8 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, info + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f class(psb_d_base_sparse_mat), optional :: amold @@ -377,7 +378,8 @@ program d_matgen ! dense matrices type(psb_d_vect_type) :: b, x ! blacs parameters - integer(psb_ipk_) :: ictxt, iam, np + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam, np ! solver parameters integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst @@ -438,7 +440,7 @@ contains ! get iteration parameters from standard input ! subroutine get_parms(ictxt,idim) - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt integer(psb_ipk_) :: idim integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: intbuf(10), ip diff --git a/test/torture/psb_c_mvsv_tester.f90 b/test/torture/psb_c_mvsv_tester.f90 index f1f72183..468a0297 100644 --- a/test/torture/psb_c_mvsv_tester.f90 +++ b/test/torture/psb_c_mvsv_tester.f90 @@ -7,7 +7,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -83,7 +84,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -159,7 +161,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -235,7 +238,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -311,7 +315,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -387,7 +392,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -463,7 +469,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -539,7 +546,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -615,7 +623,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -691,7 +700,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -767,7 +777,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -843,7 +854,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -919,7 +931,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -995,7 +1008,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1071,7 +1085,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1147,7 +1162,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1223,7 +1239,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1299,7 +1316,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1375,7 +1393,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1451,7 +1470,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1527,7 +1547,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1603,7 +1624,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1679,7 +1701,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1755,7 +1778,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1831,7 +1855,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1910,7 +1935,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1989,7 +2015,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2068,7 +2095,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2147,7 +2175,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2226,7 +2255,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2305,7 +2335,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2384,7 +2415,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2463,7 +2495,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2542,7 +2575,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2621,7 +2655,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2700,7 +2735,8 @@ contains character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i diff --git a/test/torture/psb_d_mvsv_tester.f90 b/test/torture/psb_d_mvsv_tester.f90 index 44d11336..c34bcf56 100644 --- a/test/torture/psb_d_mvsv_tester.f90 +++ b/test/torture/psb_d_mvsv_tester.f90 @@ -8,7 +8,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -84,7 +85,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -160,7 +162,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -236,7 +239,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -312,7 +316,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -388,7 +393,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -464,7 +470,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -540,7 +547,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -616,7 +624,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -692,7 +701,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -768,7 +778,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -844,7 +855,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -920,7 +932,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -996,7 +1009,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1072,7 +1086,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1148,7 +1163,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1224,7 +1240,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1300,7 +1317,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1376,7 +1394,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1452,7 +1471,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1528,7 +1548,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1604,7 +1625,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1680,7 +1702,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1756,7 +1779,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1832,7 +1856,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1911,7 +1936,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1990,7 +2016,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2069,7 +2096,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2148,7 +2176,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2227,7 +2256,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2306,7 +2336,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2385,7 +2416,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2464,7 +2496,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2543,7 +2576,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2622,7 +2656,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2701,7 +2736,8 @@ contains character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i diff --git a/test/torture/psb_s_mvsv_tester.f90 b/test/torture/psb_s_mvsv_tester.f90 index 8203067e..7330df18 100644 --- a/test/torture/psb_s_mvsv_tester.f90 +++ b/test/torture/psb_s_mvsv_tester.f90 @@ -6,7 +6,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -82,7 +83,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -158,7 +160,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -234,7 +237,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -310,7 +314,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -386,7 +391,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -462,7 +468,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -538,7 +545,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -614,7 +622,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -690,7 +699,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -766,7 +776,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -842,7 +853,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -918,7 +930,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -994,7 +1007,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1070,7 +1084,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1146,7 +1161,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1222,7 +1238,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1298,7 +1315,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1374,7 +1392,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1450,7 +1469,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1526,7 +1546,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1602,7 +1623,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1678,7 +1700,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1754,7 +1777,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1830,7 +1854,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1908,7 +1933,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1987,7 +2013,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2066,7 +2093,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2145,7 +2173,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2224,7 +2253,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2303,7 +2333,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2382,7 +2413,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2461,7 +2493,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2540,7 +2573,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2619,7 +2653,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2698,7 +2733,8 @@ contains character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i diff --git a/test/torture/psb_z_mvsv_tester.f90 b/test/torture/psb_z_mvsv_tester.f90 index 11c4b766..d3fda477 100644 --- a/test/torture/psb_z_mvsv_tester.f90 +++ b/test/torture/psb_z_mvsv_tester.f90 @@ -7,7 +7,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -83,7 +84,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -159,7 +161,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -235,7 +238,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -311,7 +315,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -387,7 +392,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -463,7 +469,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -539,7 +546,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -615,7 +623,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -691,7 +700,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -767,7 +777,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -843,7 +854,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -919,7 +931,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -995,7 +1008,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1071,7 +1085,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1147,7 +1162,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1223,7 +1239,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1299,7 +1316,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1375,7 +1393,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1451,7 +1470,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1527,7 +1547,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1603,7 +1624,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1679,7 +1701,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1755,7 +1778,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1831,7 +1855,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1910,7 +1935,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -1989,7 +2015,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2068,7 +2095,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2147,7 +2175,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2226,7 +2255,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2305,7 +2335,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2384,7 +2415,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2463,7 +2495,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2542,7 +2575,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2621,7 +2655,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i @@ -2700,7 +2735,8 @@ contains character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 integer(psb_ipk_) ::res,istat=0,i diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index 7767ce2e..2e57e4f8 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -75,7 +75,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_cspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -416,7 +416,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_lcspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_c_mat_dist_mod.f90 b/util/psb_c_mat_dist_mod.f90 index c46efd2f..8a435e70 100644 --- a/util/psb_c_mat_dist_mod.f90 +++ b/util/psb_c_mat_dist_mod.f90 @@ -32,7 +32,7 @@ module psb_c_mat_dist_mod use psb_base_mod, only : psb_ipk_, psb_spk_, psb_desc_type, psb_parts, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_vect_type, & - & psb_lcspmat_type + & psb_lcspmat_type, psb_ctxt_type interface psb_matdist subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& @@ -76,13 +76,12 @@ module psb_c_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_cspmat_type, psb_spk_, psb_desc_type,& - & psb_c_base_sparse_mat, psb_c_vect_type, psb_parts + import implicit none ! parameters type(psb_cspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -134,14 +133,12 @@ module psb_c_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_cspmat_type, psb_spk_, psb_desc_type,& - & psb_c_base_sparse_mat, psb_c_vect_type, psb_parts, & - & psb_lcspmat_type + import implicit none ! parameters type(psb_lcspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index 17df5f69..0dbc4682 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -75,7 +75,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_dspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -416,7 +416,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_ldspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_d_mat_dist_mod.f90 b/util/psb_d_mat_dist_mod.f90 index dc0e4958..a1ed3a7c 100644 --- a/util/psb_d_mat_dist_mod.f90 +++ b/util/psb_d_mat_dist_mod.f90 @@ -32,7 +32,7 @@ module psb_d_mat_dist_mod use psb_base_mod, only : psb_ipk_, psb_dpk_, psb_desc_type, psb_parts, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_vect_type, & - & psb_ldspmat_type + & psb_ldspmat_type, psb_ctxt_type interface psb_matdist subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& @@ -76,13 +76,12 @@ module psb_d_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_desc_type,& - & psb_d_base_sparse_mat, psb_d_vect_type, psb_parts + import implicit none ! parameters type(psb_dspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -134,14 +133,12 @@ module psb_d_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_desc_type,& - & psb_d_base_sparse_mat, psb_d_vect_type, psb_parts, & - & psb_ldspmat_type + import implicit none ! parameters type(psb_ldspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 8a928b84..f1c7195d 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -55,7 +55,7 @@ ! module psb_metispart_mod use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, & - & psb_err_unit, psb_spk_, psb_dpk_,& + & psb_err_unit, psb_spk_, psb_dpk_, psb_ctxt_type,& & psb_lsspmat_type, psb_lcspmat_type,& & psb_ldspmat_type, psb_lzspmat_type, & & psb_ls_csr_sparse_mat, psb_ld_csr_sparse_mat, & @@ -115,7 +115,8 @@ contains subroutine distr_mtpart(root, ictxt) use psb_base_mod implicit none - integer(psb_ipk_) :: root, ictxt + type(psb_ctxt_type) :: ictxt + integer(psb_ipk_) :: root integer(psb_ipk_) :: me, np, info integer(psb_lpk_) :: n diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 index 2ae59c3d..f4e9e5a8 100644 --- a/util/psb_s_mat_dist_impl.f90 +++ b/util/psb_s_mat_dist_impl.f90 @@ -75,7 +75,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_sspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -416,7 +416,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_lsspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_s_mat_dist_mod.f90 b/util/psb_s_mat_dist_mod.f90 index c4207da7..c1ae8cc5 100644 --- a/util/psb_s_mat_dist_mod.f90 +++ b/util/psb_s_mat_dist_mod.f90 @@ -32,7 +32,7 @@ module psb_s_mat_dist_mod use psb_base_mod, only : psb_ipk_, psb_spk_, psb_desc_type, psb_parts, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_vect_type, & - & psb_lsspmat_type + & psb_lsspmat_type, psb_ctxt_type interface psb_matdist subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& @@ -76,13 +76,12 @@ module psb_s_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_sspmat_type, psb_spk_, psb_desc_type,& - & psb_s_base_sparse_mat, psb_s_vect_type, psb_parts + import implicit none ! parameters type(psb_sspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -134,14 +133,12 @@ module psb_s_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_sspmat_type, psb_spk_, psb_desc_type,& - & psb_s_base_sparse_mat, psb_s_vect_type, psb_parts, & - & psb_lsspmat_type + import implicit none ! parameters type(psb_lsspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index d45382f3..770e3527 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -75,7 +75,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_zspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -416,7 +416,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_lzspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_z_mat_dist_mod.f90 b/util/psb_z_mat_dist_mod.f90 index d10200dd..f34e09f3 100644 --- a/util/psb_z_mat_dist_mod.f90 +++ b/util/psb_z_mat_dist_mod.f90 @@ -32,7 +32,7 @@ module psb_z_mat_dist_mod use psb_base_mod, only : psb_ipk_, psb_dpk_, psb_desc_type, psb_parts, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_vect_type, & - & psb_lzspmat_type + & psb_lzspmat_type, psb_ctxt_type interface psb_matdist subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& @@ -76,13 +76,12 @@ module psb_z_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_zspmat_type, psb_dpk_, psb_desc_type,& - & psb_z_base_sparse_mat, psb_z_vect_type, psb_parts + import implicit none ! parameters type(psb_zspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -134,14 +133,12 @@ module psb_z_mat_dist_mod ! on entry: specifies processor holding a_glob. default: 0 ! on exit : unchanged. ! - import :: psb_ipk_, psb_zspmat_type, psb_dpk_, psb_desc_type,& - & psb_z_base_sparse_mat, psb_z_vect_type, psb_parts, & - & psb_lzspmat_type + import implicit none ! parameters type(psb_lzspmat_type) :: a_glob - integer(psb_ipk_) :: ictxt + type(psb_ctxt_type) :: ictxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info From 8b2b86d44d5e93be02f4bcbc98ae0164c2a12005 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 16 Nov 2020 09:51:08 +0100 Subject: [PATCH 05/12] C interface. Not fully working yet. --- base/modules/penv/psi_penv_mod.F90 | 11 ++++++++--- cbind/test/pargen/ppdec.c | 4 ++-- cbind/test/pargen/runs/ppde.inp | 2 +- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index b9555a97..e51a61d8 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -870,7 +870,8 @@ contains include 'mpif.h' #endif type(psb_ctxt_type), intent(out) :: ictxt - integer(psb_mpk_), intent(in), optional :: np, basectxt, ids(:) + type(psb_ctxt_type), intent(in), optional :: basectxt + integer(psb_mpk_), intent(in), optional :: np, ids(:) integer(psb_mpk_) :: i, isnullcomm, icomm integer(psb_mpk_), allocatable :: iids(:) @@ -898,8 +899,12 @@ contains end if end if - if (present(basectxt)) then - basecomm = basectxt + if (present(basectxt)) then + if (allocated(basectxt%ctxt)) then + basecomm = basectxt%ctxt + else + basecomm = mpi_comm_world + end if else basecomm = mpi_comm_world end if diff --git a/cbind/test/pargen/ppdec.c b/cbind/test/pargen/ppdec.c index 986450c7..eb0ecff5 100644 --- a/cbind/test/pargen/ppdec.c +++ b/cbind/test/pargen/ppdec.c @@ -242,8 +242,8 @@ int main(int argc, char *argv[]) ictxt = psb_c_init(); psb_c_info(ictxt,&iam,&np); fprintf(stdout,"Initialization: am %d of %d\n",iam,np); - fflush(stdout); + psb_c_barrier(ictxt); if (iam == 0) { fgets(buffer,LINEBUFSIZE,stdin); @@ -278,7 +278,7 @@ int main(int argc, char *argv[]) fprintf(stderr,"%d Check on received: methd %s ptype %s afmt %s\n", iam,methd,ptype,afmt); - + fflush(stderr); psb_c_barrier(ictxt); cdh=psb_c_new_descriptor(); diff --git a/cbind/test/pargen/runs/ppde.inp b/cbind/test/pargen/runs/ppde.inp index e0162591..d16c607f 100644 --- a/cbind/test/pargen/runs/ppde.inp +++ b/cbind/test/pargen/runs/ppde.inp @@ -2,7 +2,7 @@ BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES BJAC Preconditioner NONE DIAG BJAC CSR A Storage format CSR COO -100 Domain size (acutal system is this**3) +080 Domain size (acutal system is this**3) 1 Stopping criterion 80 MAXIT 01 ITRACE From 6a6f6ad2c227c39fd1c2919ed7c76767bac3ca27 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 16 Nov 2020 16:15:48 +0100 Subject: [PATCH 06/12] Change name of ICTXT to CTXT --- base/comm/internals/psi_covrl_restr.f90 | 16 +- base/comm/internals/psi_covrl_restr_a.f90 | 16 +- base/comm/internals/psi_covrl_save.f90 | 16 +- base/comm/internals/psi_covrl_save_a.f90 | 16 +- base/comm/internals/psi_covrl_upd.f90 | 16 +- base/comm/internals/psi_covrl_upd_a.f90 | 16 +- base/comm/internals/psi_cswapdata.F90 | 48 +-- base/comm/internals/psi_cswapdata_a.F90 | 72 ++-- base/comm/internals/psi_cswaptran.F90 | 48 +-- base/comm/internals/psi_cswaptran_a.F90 | 76 ++-- base/comm/internals/psi_dovrl_restr.f90 | 16 +- base/comm/internals/psi_dovrl_restr_a.f90 | 16 +- base/comm/internals/psi_dovrl_save.f90 | 16 +- base/comm/internals/psi_dovrl_save_a.f90 | 16 +- base/comm/internals/psi_dovrl_upd.f90 | 16 +- base/comm/internals/psi_dovrl_upd_a.f90 | 16 +- base/comm/internals/psi_dswapdata.F90 | 48 +-- base/comm/internals/psi_dswapdata_a.F90 | 72 ++-- base/comm/internals/psi_dswaptran.F90 | 48 +-- base/comm/internals/psi_dswaptran_a.F90 | 76 ++-- base/comm/internals/psi_eovrl_restr_a.f90 | 16 +- base/comm/internals/psi_eovrl_save_a.f90 | 16 +- base/comm/internals/psi_eovrl_upd_a.f90 | 16 +- base/comm/internals/psi_eswapdata_a.F90 | 72 ++-- base/comm/internals/psi_eswaptran_a.F90 | 76 ++-- base/comm/internals/psi_i2ovrl_restr_a.f90 | 16 +- base/comm/internals/psi_i2ovrl_save_a.f90 | 16 +- base/comm/internals/psi_i2ovrl_upd_a.f90 | 16 +- base/comm/internals/psi_i2swapdata_a.F90 | 72 ++-- base/comm/internals/psi_i2swaptran_a.F90 | 76 ++-- base/comm/internals/psi_iovrl_restr.f90 | 16 +- base/comm/internals/psi_iovrl_save.f90 | 16 +- base/comm/internals/psi_iovrl_upd.f90 | 16 +- base/comm/internals/psi_iswapdata.F90 | 48 +-- base/comm/internals/psi_iswaptran.F90 | 48 +-- base/comm/internals/psi_lovrl_restr.f90 | 16 +- base/comm/internals/psi_lovrl_save.f90 | 16 +- base/comm/internals/psi_lovrl_upd.f90 | 16 +- base/comm/internals/psi_lswapdata.F90 | 48 +-- base/comm/internals/psi_lswaptran.F90 | 48 +-- base/comm/internals/psi_movrl_restr_a.f90 | 16 +- base/comm/internals/psi_movrl_save_a.f90 | 16 +- base/comm/internals/psi_movrl_upd_a.f90 | 16 +- base/comm/internals/psi_mswapdata_a.F90 | 72 ++-- base/comm/internals/psi_mswaptran_a.F90 | 76 ++-- base/comm/internals/psi_sovrl_restr.f90 | 16 +- base/comm/internals/psi_sovrl_restr_a.f90 | 16 +- base/comm/internals/psi_sovrl_save.f90 | 16 +- base/comm/internals/psi_sovrl_save_a.f90 | 16 +- base/comm/internals/psi_sovrl_upd.f90 | 16 +- base/comm/internals/psi_sovrl_upd_a.f90 | 16 +- base/comm/internals/psi_sswapdata.F90 | 48 +-- base/comm/internals/psi_sswapdata_a.F90 | 72 ++-- base/comm/internals/psi_sswaptran.F90 | 48 +-- base/comm/internals/psi_sswaptran_a.F90 | 76 ++-- base/comm/internals/psi_zovrl_restr.f90 | 16 +- base/comm/internals/psi_zovrl_restr_a.f90 | 16 +- base/comm/internals/psi_zovrl_save.f90 | 16 +- base/comm/internals/psi_zovrl_save_a.f90 | 16 +- base/comm/internals/psi_zovrl_upd.f90 | 16 +- base/comm/internals/psi_zovrl_upd_a.f90 | 16 +- base/comm/internals/psi_zswapdata.F90 | 48 +-- base/comm/internals/psi_zswapdata_a.F90 | 72 ++-- base/comm/internals/psi_zswaptran.F90 | 48 +-- base/comm/internals/psi_zswaptran_a.F90 | 76 ++-- base/comm/psb_cgather.f90 | 20 +- base/comm/psb_cgather_a.f90 | 22 +- base/comm/psb_chalo.f90 | 16 +- base/comm/psb_chalo_a.f90 | 16 +- base/comm/psb_covrl.f90 | 16 +- base/comm/psb_covrl_a.f90 | 16 +- base/comm/psb_cscatter.F90 | 8 +- base/comm/psb_cscatter_a.F90 | 28 +- base/comm/psb_cspgather.F90 | 30 +- base/comm/psb_dgather.f90 | 20 +- base/comm/psb_dgather_a.f90 | 22 +- base/comm/psb_dhalo.f90 | 16 +- base/comm/psb_dhalo_a.f90 | 16 +- base/comm/psb_dovrl.f90 | 16 +- base/comm/psb_dovrl_a.f90 | 16 +- base/comm/psb_dscatter.F90 | 8 +- base/comm/psb_dscatter_a.F90 | 28 +- base/comm/psb_dspgather.F90 | 30 +- base/comm/psb_egather_a.f90 | 22 +- base/comm/psb_ehalo_a.f90 | 16 +- base/comm/psb_eovrl_a.f90 | 16 +- base/comm/psb_escatter_a.F90 | 28 +- base/comm/psb_i2gather_a.f90 | 22 +- base/comm/psb_i2halo_a.f90 | 16 +- base/comm/psb_i2ovrl_a.f90 | 16 +- base/comm/psb_i2scatter_a.F90 | 28 +- base/comm/psb_igather.f90 | 20 +- base/comm/psb_ihalo.f90 | 16 +- base/comm/psb_iovrl.f90 | 16 +- base/comm/psb_iscatter.F90 | 8 +- base/comm/psb_ispgather.F90 | 30 +- base/comm/psb_lgather.f90 | 20 +- base/comm/psb_lhalo.f90 | 16 +- base/comm/psb_lovrl.f90 | 16 +- base/comm/psb_lscatter.F90 | 8 +- base/comm/psb_lspgather.F90 | 30 +- base/comm/psb_mgather_a.f90 | 22 +- base/comm/psb_mhalo_a.f90 | 16 +- base/comm/psb_movrl_a.f90 | 16 +- base/comm/psb_mscatter_a.F90 | 28 +- base/comm/psb_sgather.f90 | 20 +- base/comm/psb_sgather_a.f90 | 22 +- base/comm/psb_shalo.f90 | 16 +- base/comm/psb_shalo_a.f90 | 16 +- base/comm/psb_sovrl.f90 | 16 +- base/comm/psb_sovrl_a.f90 | 16 +- base/comm/psb_sscatter.F90 | 8 +- base/comm/psb_sscatter_a.F90 | 28 +- base/comm/psb_sspgather.F90 | 30 +- base/comm/psb_zgather.f90 | 20 +- base/comm/psb_zgather_a.f90 | 22 +- base/comm/psb_zhalo.f90 | 16 +- base/comm/psb_zhalo_a.f90 | 16 +- base/comm/psb_zovrl.f90 | 16 +- base/comm/psb_zovrl_a.f90 | 16 +- base/comm/psb_zscatter.F90 | 8 +- base/comm/psb_zscatter_a.F90 | 28 +- base/comm/psb_zspgather.F90 | 30 +- base/internals/psi_a2a_fnd_owner.F90 | 8 +- base/internals/psi_adjcncy_fnd_owner.F90 | 24 +- base/internals/psi_bld_glb_dep_list.F90 | 22 +- base/internals/psi_bld_tmphalo.f90 | 8 +- base/internals/psi_bld_tmpovrl.f90 | 8 +- base/internals/psi_compute_size.f90 | 10 +- base/internals/psi_crea_index.f90 | 14 +- base/internals/psi_desc_impl.f90 | 8 +- base/internals/psi_desc_index.F90 | 28 +- base/internals/psi_extrct_dl.F90 | 22 +- base/internals/psi_fnd_owner.F90 | 8 +- base/internals/psi_graph_fnd_owner.F90 | 24 +- base/internals/psi_indx_map_fnd_owner.F90 | 16 +- base/internals/psi_sort_dl.f90 | 6 +- base/internals/psi_symm_dep_list.F90 | 22 +- base/internals/psi_xtr_loc_dl.F90 | 10 +- base/modules/comm/psi_c_comm_a_mod.f90 | 16 +- base/modules/comm/psi_c_comm_v_mod.f90 | 16 +- base/modules/comm/psi_d_comm_a_mod.f90 | 16 +- base/modules/comm/psi_d_comm_v_mod.f90 | 16 +- base/modules/comm/psi_e_comm_a_mod.f90 | 16 +- base/modules/comm/psi_i2_comm_a_mod.f90 | 16 +- base/modules/comm/psi_i_comm_v_mod.f90 | 16 +- base/modules/comm/psi_l_comm_v_mod.f90 | 16 +- base/modules/comm/psi_m_comm_a_mod.f90 | 16 +- base/modules/comm/psi_s_comm_a_mod.f90 | 16 +- base/modules/comm/psi_s_comm_v_mod.f90 | 16 +- base/modules/comm/psi_z_comm_a_mod.f90 | 16 +- base/modules/comm/psi_z_comm_v_mod.f90 | 16 +- base/modules/desc/psb_desc_mod.F90 | 50 +-- base/modules/desc/psb_gen_block_map_mod.F90 | 50 +-- base/modules/desc/psb_glist_map_mod.f90 | 18 +- base/modules/desc/psb_hash_map_mod.f90 | 70 ++-- base/modules/desc/psb_indx_map_mod.f90 | 26 +- base/modules/desc/psb_list_map_mod.f90 | 32 +- base/modules/desc/psb_repl_map_mod.f90 | 24 +- base/modules/error.f90 | 12 +- base/modules/penv/psi_c_collective_mod.F90 | 162 ++++---- base/modules/penv/psi_c_p2p_mod.F90 | 38 +- base/modules/penv/psi_collective_mod.F90 | 64 +-- base/modules/penv/psi_d_collective_mod.F90 | 226 +++++----- base/modules/penv/psi_d_p2p_mod.F90 | 38 +- base/modules/penv/psi_e_collective_mod.F90 | 210 +++++----- base/modules/penv/psi_e_p2p_mod.F90 | 38 +- base/modules/penv/psi_i2_collective_mod.F90 | 210 +++++----- base/modules/penv/psi_i2_p2p_mod.F90 | 38 +- base/modules/penv/psi_m_collective_mod.F90 | 210 +++++----- base/modules/penv/psi_m_p2p_mod.F90 | 38 +- base/modules/penv/psi_p2p_mod.F90 | 48 +-- base/modules/penv/psi_penv_mod.F90 | 150 +++---- base/modules/penv/psi_s_collective_mod.F90 | 226 +++++----- base/modules/penv/psi_s_p2p_mod.F90 | 38 +- base/modules/penv/psi_z_collective_mod.F90 | 162 ++++---- base/modules/penv/psi_z_p2p_mod.F90 | 38 +- base/modules/psb_const_mod.F90 | 2 +- base/modules/psb_error_impl.F90 | 36 +- base/modules/psb_error_mod.F90 | 20 +- base/modules/psb_timers_mod.f90 | 10 +- base/modules/psi_i_mod.F90 | 20 +- base/modules/tools/psb_cd_tools_mod.F90 | 4 +- base/psblas/psb_cabs_vect.f90 | 8 +- base/psblas/psb_camax.f90 | 50 +-- base/psblas/psb_casum.f90 | 40 +- base/psblas/psb_caxpby.f90 | 48 +-- base/psblas/psb_ccmp_vect.f90 | 32 +- base/psblas/psb_cdiv_vect.f90 | 32 +- base/psblas/psb_cdot.f90 | 50 +-- base/psblas/psb_cgetmatinfo.f90 | 10 +- base/psblas/psb_cinv_vect.f90 | 18 +- base/psblas/psb_cmlt_vect.f90 | 16 +- base/psblas/psb_cnrm2.f90 | 60 +-- base/psblas/psb_cnrmi.f90 | 10 +- base/psblas/psb_cspmm.f90 | 28 +- base/psblas/psb_cspnrm1.f90 | 10 +- base/psblas/psb_cspsm.f90 | 24 +- base/psblas/psb_cvmlt.f90 | 8 +- base/psblas/psb_dabs_vect.f90 | 8 +- base/psblas/psb_damax.f90 | 60 +-- base/psblas/psb_dasum.f90 | 40 +- base/psblas/psb_daxpby.f90 | 48 +-- base/psblas/psb_dcmp_vect.f90 | 42 +- base/psblas/psb_ddiv_vect.f90 | 42 +- base/psblas/psb_ddot.f90 | 50 +-- base/psblas/psb_dgetmatinfo.f90 | 10 +- base/psblas/psb_dinv_vect.f90 | 18 +- base/psblas/psb_dmlt_vect.f90 | 16 +- base/psblas/psb_dnrm2.f90 | 60 +-- base/psblas/psb_dnrmi.f90 | 10 +- base/psblas/psb_dspmm.f90 | 28 +- base/psblas/psb_dspnrm1.f90 | 10 +- base/psblas/psb_dspsm.f90 | 24 +- base/psblas/psb_dvmlt.f90 | 8 +- base/psblas/psb_sabs_vect.f90 | 8 +- base/psblas/psb_samax.f90 | 60 +-- base/psblas/psb_sasum.f90 | 40 +- base/psblas/psb_saxpby.f90 | 48 +-- base/psblas/psb_scmp_vect.f90 | 42 +- base/psblas/psb_sdiv_vect.f90 | 42 +- base/psblas/psb_sdot.f90 | 50 +-- base/psblas/psb_sgetmatinfo.f90 | 10 +- base/psblas/psb_sinv_vect.f90 | 18 +- base/psblas/psb_smlt_vect.f90 | 16 +- base/psblas/psb_snrm2.f90 | 60 +-- base/psblas/psb_snrmi.f90 | 10 +- base/psblas/psb_sspmm.f90 | 28 +- base/psblas/psb_sspnrm1.f90 | 10 +- base/psblas/psb_sspsm.f90 | 24 +- base/psblas/psb_svmlt.f90 | 8 +- base/psblas/psb_zabs_vect.f90 | 8 +- base/psblas/psb_zamax.f90 | 50 +-- base/psblas/psb_zasum.f90 | 40 +- base/psblas/psb_zaxpby.f90 | 48 +-- base/psblas/psb_zcmp_vect.f90 | 32 +- base/psblas/psb_zdiv_vect.f90 | 32 +- base/psblas/psb_zdot.f90 | 50 +-- base/psblas/psb_zgetmatinfo.f90 | 10 +- base/psblas/psb_zinv_vect.f90 | 18 +- base/psblas/psb_zmlt_vect.f90 | 16 +- base/psblas/psb_znrm2.f90 | 60 +-- base/psblas/psb_znrmi.f90 | 10 +- base/psblas/psb_zspmm.f90 | 28 +- base/psblas/psb_zspnrm1.f90 | 10 +- base/psblas/psb_zspsm.f90 | 24 +- base/psblas/psb_zvmlt.f90 | 8 +- base/serial/psb_sgelp.f90 | 4 +- base/tools/psb_c_glob_transpose.F90 | 64 +-- base/tools/psb_c_map.f90 | 48 +-- base/tools/psb_c_par_csr_spspmm.f90 | 16 +- base/tools/psb_callc.f90 | 32 +- base/tools/psb_callc_a.f90 | 20 +- base/tools/psb_casb.f90 | 24 +- base/tools/psb_casb_a.f90 | 18 +- base/tools/psb_ccdbldext.F90 | 16 +- base/tools/psb_cd_inloc.f90 | 52 +-- base/tools/psb_cd_lstext.f90 | 10 +- base/tools/psb_cd_reinit.f90 | 8 +- base/tools/psb_cd_renum_block.F90 | 12 +- base/tools/psb_cd_set_bld.f90 | 8 +- base/tools/psb_cd_switch_ovl_indxmap.f90 | 12 +- base/tools/psb_cdall.f90 | 40 +- base/tools/psb_cdals.f90 | 18 +- base/tools/psb_cdalv.f90 | 22 +- base/tools/psb_cdcpy.F90 | 8 +- base/tools/psb_cdins.F90 | 16 +- base/tools/psb_cdprt.f90 | 26 +- base/tools/psb_cdren.f90 | 8 +- base/tools/psb_cdrep.f90 | 16 +- base/tools/psb_cfree.f90 | 24 +- base/tools/psb_cfree_a.f90 | 16 +- base/tools/psb_cgetelem.f90 | 8 +- base/tools/psb_cins.f90 | 32 +- base/tools/psb_cins_a.f90 | 16 +- base/tools/psb_cspalloc.f90 | 8 +- base/tools/psb_cspasb.f90 | 8 +- base/tools/psb_cspfree.f90 | 6 +- base/tools/psb_csphalo.F90 | 72 ++-- base/tools/psb_cspins.F90 | 40 +- base/tools/psb_csprn.f90 | 8 +- base/tools/psb_d_glob_transpose.F90 | 64 +-- base/tools/psb_d_map.f90 | 48 +-- base/tools/psb_d_par_csr_spspmm.f90 | 16 +- base/tools/psb_dallc.f90 | 32 +- base/tools/psb_dallc_a.f90 | 20 +- base/tools/psb_dasb.f90 | 24 +- base/tools/psb_dasb_a.f90 | 18 +- base/tools/psb_dcdbldext.F90 | 16 +- base/tools/psb_dfree.f90 | 24 +- base/tools/psb_dfree_a.f90 | 16 +- base/tools/psb_dgetelem.f90 | 8 +- base/tools/psb_dins.f90 | 32 +- base/tools/psb_dins_a.f90 | 16 +- base/tools/psb_dspalloc.f90 | 8 +- base/tools/psb_dspasb.f90 | 8 +- base/tools/psb_dspfree.f90 | 6 +- base/tools/psb_dsphalo.F90 | 72 ++-- base/tools/psb_dspins.F90 | 40 +- base/tools/psb_dsprn.f90 | 8 +- base/tools/psb_eallc_a.f90 | 20 +- base/tools/psb_easb_a.f90 | 18 +- base/tools/psb_efree_a.f90 | 16 +- base/tools/psb_eins_a.f90 | 16 +- base/tools/psb_glob_to_loc.f90 | 16 +- base/tools/psb_i2allc_a.f90 | 20 +- base/tools/psb_i2asb_a.f90 | 18 +- base/tools/psb_i2free_a.f90 | 16 +- base/tools/psb_i2ins_a.f90 | 16 +- base/tools/psb_iallc.f90 | 32 +- base/tools/psb_iasb.f90 | 24 +- base/tools/psb_icdasb.F90 | 8 +- base/tools/psb_ifree.f90 | 24 +- base/tools/psb_iins.f90 | 32 +- base/tools/psb_lallc.f90 | 32 +- base/tools/psb_lasb.f90 | 24 +- base/tools/psb_lfree.f90 | 24 +- base/tools/psb_lins.f90 | 32 +- base/tools/psb_mallc_a.f90 | 20 +- base/tools/psb_masb_a.f90 | 18 +- base/tools/psb_mfree_a.f90 | 16 +- base/tools/psb_mins_a.f90 | 16 +- base/tools/psb_s_glob_transpose.F90 | 64 +-- base/tools/psb_s_map.f90 | 48 +-- base/tools/psb_s_par_csr_spspmm.f90 | 16 +- base/tools/psb_sallc.f90 | 32 +- base/tools/psb_sallc_a.f90 | 20 +- base/tools/psb_sasb.f90 | 24 +- base/tools/psb_sasb_a.f90 | 18 +- base/tools/psb_scdbldext.F90 | 16 +- base/tools/psb_sfree.f90 | 24 +- base/tools/psb_sfree_a.f90 | 16 +- base/tools/psb_sgetelem.f90 | 8 +- base/tools/psb_sins.f90 | 32 +- base/tools/psb_sins_a.f90 | 16 +- base/tools/psb_sspalloc.f90 | 8 +- base/tools/psb_sspasb.f90 | 8 +- base/tools/psb_sspfree.f90 | 6 +- base/tools/psb_ssphalo.F90 | 72 ++-- base/tools/psb_sspins.F90 | 40 +- base/tools/psb_ssprn.f90 | 8 +- base/tools/psb_z_glob_transpose.F90 | 64 +-- base/tools/psb_z_map.f90 | 48 +-- base/tools/psb_z_par_csr_spspmm.f90 | 16 +- base/tools/psb_zallc.f90 | 32 +- base/tools/psb_zallc_a.f90 | 20 +- base/tools/psb_zasb.f90 | 24 +- base/tools/psb_zasb_a.f90 | 18 +- base/tools/psb_zcdbldext.F90 | 16 +- base/tools/psb_zfree.f90 | 24 +- base/tools/psb_zfree_a.f90 | 16 +- base/tools/psb_zgetelem.f90 | 8 +- base/tools/psb_zins.f90 | 32 +- base/tools/psb_zins_a.f90 | 16 +- base/tools/psb_zspalloc.f90 | 8 +- base/tools/psb_zspasb.f90 | 8 +- base/tools/psb_zspfree.f90 | 6 +- base/tools/psb_zsphalo.F90 | 72 ++-- base/tools/psb_zspins.F90 | 40 +- base/tools/psb_zsprn.f90 | 8 +- krylov/psb_base_krylov_conv_mod.f90 | 6 +- krylov/psb_c_krylov_conv_mod.f90 | 32 +- krylov/psb_cbicg.f90 | 6 +- krylov/psb_ccg.F90 | 6 +- krylov/psb_ccgs.f90 | 6 +- krylov/psb_ccgstab.f90 | 6 +- krylov/psb_ccgstabl.f90 | 6 +- krylov/psb_cfcg.F90 | 10 +- krylov/psb_cgcr.f90 | 6 +- krylov/psb_ckrylov.f90 | 8 +- krylov/psb_crgmres.f90 | 6 +- krylov/psb_d_krylov_conv_mod.f90 | 32 +- krylov/psb_dbicg.f90 | 6 +- krylov/psb_dcg.F90 | 8 +- krylov/psb_dcgs.f90 | 6 +- krylov/psb_dcgstab.f90 | 6 +- krylov/psb_dcgstabl.f90 | 6 +- krylov/psb_dfcg.F90 | 10 +- krylov/psb_dgcr.f90 | 6 +- krylov/psb_dkrylov.f90 | 8 +- krylov/psb_drgmres.f90 | 6 +- krylov/psb_s_krylov_conv_mod.f90 | 32 +- krylov/psb_sbicg.f90 | 6 +- krylov/psb_scg.F90 | 8 +- krylov/psb_scgs.f90 | 6 +- krylov/psb_scgstab.f90 | 6 +- krylov/psb_scgstabl.f90 | 6 +- krylov/psb_sfcg.F90 | 10 +- krylov/psb_sgcr.f90 | 6 +- krylov/psb_skrylov.f90 | 8 +- krylov/psb_srgmres.f90 | 6 +- krylov/psb_z_krylov_conv_mod.f90 | 32 +- krylov/psb_zbicg.f90 | 6 +- krylov/psb_zcg.F90 | 6 +- krylov/psb_zcgs.f90 | 6 +- krylov/psb_zcgstab.f90 | 6 +- krylov/psb_zcgstabl.f90 | 6 +- krylov/psb_zfcg.F90 | 10 +- krylov/psb_zgcr.f90 | 6 +- krylov/psb_zkrylov.f90 | 8 +- krylov/psb_zrgmres.f90 | 6 +- prec/impl/psb_c_bjacprec_impl.f90 | 26 +- prec/impl/psb_c_diagprec_impl.f90 | 6 +- prec/impl/psb_c_prec_type_impl.f90 | 24 +- prec/impl/psb_cprecbld.f90 | 6 +- prec/impl/psb_cprecinit.f90 | 6 +- prec/impl/psb_d_bjacprec_impl.f90 | 26 +- prec/impl/psb_d_diagprec_impl.f90 | 6 +- prec/impl/psb_d_prec_type_impl.f90 | 24 +- prec/impl/psb_dprecbld.f90 | 6 +- prec/impl/psb_dprecinit.f90 | 6 +- prec/impl/psb_s_bjacprec_impl.f90 | 26 +- prec/impl/psb_s_diagprec_impl.f90 | 6 +- prec/impl/psb_s_prec_type_impl.f90 | 24 +- prec/impl/psb_sprecbld.f90 | 6 +- prec/impl/psb_sprecinit.f90 | 6 +- prec/impl/psb_z_bjacprec_impl.f90 | 26 +- prec/impl/psb_z_diagprec_impl.f90 | 6 +- prec/impl/psb_z_prec_type_impl.f90 | 24 +- prec/impl/psb_zprecbld.f90 | 6 +- prec/impl/psb_zprecinit.f90 | 6 +- prec/psb_c_base_prec_mod.f90 | 16 +- prec/psb_c_bjacprec.f90 | 6 +- prec/psb_c_diagprec.f90 | 6 +- prec/psb_c_nullprec.f90 | 12 +- prec/psb_c_prec_type.f90 | 6 +- prec/psb_d_base_prec_mod.f90 | 16 +- prec/psb_d_bjacprec.f90 | 6 +- prec/psb_d_diagprec.f90 | 6 +- prec/psb_d_nullprec.f90 | 12 +- prec/psb_d_prec_type.f90 | 6 +- prec/psb_s_base_prec_mod.f90 | 16 +- prec/psb_s_bjacprec.f90 | 6 +- prec/psb_s_diagprec.f90 | 6 +- prec/psb_s_nullprec.f90 | 12 +- prec/psb_s_prec_type.f90 | 6 +- prec/psb_z_base_prec_mod.f90 | 16 +- prec/psb_z_bjacprec.f90 | 6 +- prec/psb_z_diagprec.f90 | 6 +- prec/psb_z_nullprec.f90 | 12 +- prec/psb_z_prec_type.f90 | 6 +- test/cdasb/psb_d_pde3d.f90 | 104 ++--- test/fileread/getp.f90 | 92 ++--- test/fileread/psb_cf_sample.f90 | 50 +-- test/fileread/psb_df_sample.f90 | 50 +-- test/fileread/psb_sf_sample.f90 | 50 +-- test/fileread/psb_zf_sample.f90 | 50 +-- test/kernel/d_file_spmv.f90 | 58 +-- test/kernel/pdgenspmv.f90 | 106 ++--- test/kernel/s_file_spmv.f90 | 58 +-- test/kernel/vecoperation.f90 | 122 +++--- test/pargen/psb_d_pde2d.f90 | 122 +++--- test/pargen/psb_d_pde3d.f90 | 122 +++--- test/pargen/psb_s_pde2d.f90 | 122 +++--- test/pargen/psb_s_pde3d.f90 | 122 +++--- test/serial/d_matgen.F90 | 72 ++-- test/torture/psb_c_mvsv_tester.f90 | 432 ++++++++++---------- test/torture/psb_d_mvsv_tester.f90 | 432 ++++++++++---------- test/torture/psb_s_mvsv_tester.f90 | 432 ++++++++++---------- test/torture/psb_z_mvsv_tester.f90 | 432 ++++++++++---------- test/torture/psbtf.f90 | 296 +++++++------- util/psb_c_mat_dist_impl.f90 | 104 ++--- util/psb_c_mat_dist_mod.f90 | 12 +- util/psb_d_mat_dist_impl.f90 | 104 ++--- util/psb_d_mat_dist_mod.f90 | 12 +- util/psb_metispart_mod.F90 | 18 +- util/psb_s_mat_dist_impl.f90 | 104 ++--- util/psb_s_mat_dist_mod.f90 | 12 +- util/psb_z_mat_dist_impl.f90 | 104 ++--- util/psb_z_mat_dist_mod.f90 | 12 +- 470 files changed, 7601 insertions(+), 7601 deletions(-) diff --git a/base/comm/internals/psi_covrl_restr.f90 b/base/comm/internals/psi_covrl_restr.f90 index a409dfd9..c0276bfd 100644 --- a/base/comm/internals/psi_covrl_restr.f90 +++ b/base/comm/internals/psi_covrl_restr.f90 @@ -47,7 +47,7 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -72,7 +72,7 @@ subroutine psi_covrl_restr_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_restr_vect @@ -90,7 +90,7 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -100,8 +100,8 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,7 +114,7 @@ subroutine psi_covrl_restr_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_restr_multivect diff --git a/base/comm/internals/psi_covrl_restr_a.f90 b/base/comm/internals/psi_covrl_restr_a.f90 index 801e59cc..0ad65753 100644 --- a/base/comm/internals/psi_covrl_restr_a.f90 +++ b/base/comm/internals/psi_covrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_covrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_covrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_restrr2 diff --git a/base/comm/internals/psi_covrl_save.f90 b/base/comm/internals/psi_covrl_save.f90 index 9dd60edd..8ee6dc9c 100644 --- a/base/comm/internals/psi_covrl_save.f90 +++ b/base/comm/internals/psi_covrl_save.f90 @@ -47,7 +47,7 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -78,7 +78,7 @@ subroutine psi_covrl_save_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_save_vect @@ -96,7 +96,7 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -106,8 +106,8 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -128,7 +128,7 @@ subroutine psi_covrl_save_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_save_multivect diff --git a/base/comm/internals/psi_covrl_save_a.f90 b/base/comm/internals/psi_covrl_save_a.f90 index 8607df7a..6910a2a4 100644 --- a/base/comm/internals/psi_covrl_save_a.f90 +++ b/base/comm/internals/psi_covrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_covrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_covrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_saver2 diff --git a/base/comm/internals/psi_covrl_upd.f90 b/base/comm/internals/psi_covrl_upd.f90 index d3c8a5c0..c829e570 100644 --- a/base/comm/internals/psi_covrl_upd.f90 +++ b/base/comm/internals/psi_covrl_upd.f90 @@ -50,7 +50,7 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -62,8 +62,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -113,7 +113,7 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_upd_vect @@ -132,7 +132,7 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -144,8 +144,8 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -196,7 +196,7 @@ subroutine psi_covrl_upd_multivect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_upd_multivect diff --git a/base/comm/internals/psi_covrl_upd_a.f90 b/base/comm/internals/psi_covrl_upd_a.f90 index 7483a4fd..813cd88b 100644 --- a/base/comm/internals/psi_covrl_upd_a.f90 +++ b/base/comm/internals/psi_covrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_covrl_updr2 diff --git a/base/comm/internals/psi_cswapdata.F90 b/base/comm/internals/psi_cswapdata.F90 index d416a6ff..5af5b79e 100644 --- a/base/comm/internals/psi_cswapdata.F90 +++ b/base/comm/internals/psi_cswapdata.F90 @@ -113,7 +113,7 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -123,9 +123,9 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -150,13 +150,13 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswapdata_vect @@ -175,7 +175,7 @@ end subroutine psi_cswapdata_vect ! ! ! -subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_cswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_cswap_vidx_vect @@ -192,7 +192,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -203,7 +203,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -218,10 +218,10 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -265,7 +265,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & nesd = idx%v(pnti+nerv+psb_n_elem_send_) rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_complex_swap_tag @@ -418,7 +418,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswap_vidx_vect @@ -455,7 +455,7 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -465,9 +465,9 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -492,13 +492,13 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswapdata_multivect @@ -517,7 +517,7 @@ end subroutine psi_cswapdata_multivect ! ! ! -subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_cswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_cswap_vidx_multivect @@ -534,7 +534,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -545,7 +545,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -560,10 +560,10 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -609,7 +609,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_complex_swap_tag @@ -766,7 +766,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswap_vidx_multivect diff --git a/base/comm/internals/psi_cswapdata_a.F90 b/base/comm/internals/psi_cswapdata_a.F90 index e627a4b0..43b91872 100644 --- a/base/comm/internals/psi_cswapdata_a.F90 +++ b/base/comm/internals/psi_cswapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswapdatam -subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_cswapidxm @@ -169,7 +169,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswapidxm @@ -582,7 +582,7 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswapdatav @@ -641,7 +641,7 @@ end subroutine psi_cswapdatav ! ! ! -subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_cswapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_cswapidxv @@ -656,7 +656,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswapidxv diff --git a/base/comm/internals/psi_cswaptran.F90 b/base/comm/internals/psi_cswaptran.F90 index 9d87156f..401d8435 100644 --- a/base/comm/internals/psi_cswaptran.F90 +++ b/base/comm/internals/psi_cswaptran.F90 @@ -115,7 +115,7 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -125,9 +125,9 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -152,13 +152,13 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswaptran_vect @@ -176,7 +176,7 @@ end subroutine psi_cswaptran_vect ! ! ! -subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ctran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ctran_vidx_vect @@ -193,7 +193,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -204,7 +204,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -219,10 +219,10 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& snd_pt = 1+pnti+nerv+psb_n_elem_send_ rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& @@ -425,7 +425,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -466,7 +466,7 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -476,9 +476,9 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -503,13 +503,13 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswaptran_multivect @@ -528,7 +528,7 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! ! ! -subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ctran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ctran_vidx_multivect @@ -545,7 +545,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -556,7 +556,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -571,10 +571,10 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -621,7 +621,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& @@ -781,7 +781,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/internals/psi_cswaptran_a.F90 b/base/comm/internals/psi_cswaptran_a.F90 index 6792be29..508e445d 100644 --- a/base/comm/internals/psi_cswaptran_a.F90 +++ b/base/comm/internals/psi_cswaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswaptranm -subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_ctranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ctranidxm @@ -174,7 +174,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_ctranidxm @@ -597,7 +597,7 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_cswaptranv @@ -656,7 +656,7 @@ end subroutine psi_cswaptranv ! ! ! -subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ctranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ctranidxv @@ -671,7 +671,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_complex_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_ctranidxv diff --git a/base/comm/internals/psi_dovrl_restr.f90 b/base/comm/internals/psi_dovrl_restr.f90 index 5ed758ed..22a77328 100644 --- a/base/comm/internals/psi_dovrl_restr.f90 +++ b/base/comm/internals/psi_dovrl_restr.f90 @@ -47,7 +47,7 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -72,7 +72,7 @@ subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_restr_vect @@ -90,7 +90,7 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -100,8 +100,8 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,7 +114,7 @@ subroutine psi_dovrl_restr_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_restr_multivect diff --git a/base/comm/internals/psi_dovrl_restr_a.f90 b/base/comm/internals/psi_dovrl_restr_a.f90 index 7cd9e32b..768f6b26 100644 --- a/base/comm/internals/psi_dovrl_restr_a.f90 +++ b/base/comm/internals/psi_dovrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_dovrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_dovrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_restrr2 diff --git a/base/comm/internals/psi_dovrl_save.f90 b/base/comm/internals/psi_dovrl_save.f90 index a701a239..38a83d2d 100644 --- a/base/comm/internals/psi_dovrl_save.f90 +++ b/base/comm/internals/psi_dovrl_save.f90 @@ -47,7 +47,7 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -78,7 +78,7 @@ subroutine psi_dovrl_save_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_save_vect @@ -96,7 +96,7 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -106,8 +106,8 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -128,7 +128,7 @@ subroutine psi_dovrl_save_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_save_multivect diff --git a/base/comm/internals/psi_dovrl_save_a.f90 b/base/comm/internals/psi_dovrl_save_a.f90 index b214c9a6..25c821b8 100644 --- a/base/comm/internals/psi_dovrl_save_a.f90 +++ b/base/comm/internals/psi_dovrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_dovrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_dovrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_saver2 diff --git a/base/comm/internals/psi_dovrl_upd.f90 b/base/comm/internals/psi_dovrl_upd.f90 index 20fb80f1..261971ba 100644 --- a/base/comm/internals/psi_dovrl_upd.f90 +++ b/base/comm/internals/psi_dovrl_upd.f90 @@ -50,7 +50,7 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -62,8 +62,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -113,7 +113,7 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_upd_vect @@ -132,7 +132,7 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -144,8 +144,8 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -196,7 +196,7 @@ subroutine psi_dovrl_upd_multivect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_upd_multivect diff --git a/base/comm/internals/psi_dovrl_upd_a.f90 b/base/comm/internals/psi_dovrl_upd_a.f90 index f3fb3da9..9678d3e3 100644 --- a/base/comm/internals/psi_dovrl_upd_a.f90 +++ b/base/comm/internals/psi_dovrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dovrl_updr2 diff --git a/base/comm/internals/psi_dswapdata.F90 b/base/comm/internals/psi_dswapdata.F90 index 0f28408b..f99f0254 100644 --- a/base/comm/internals/psi_dswapdata.F90 +++ b/base/comm/internals/psi_dswapdata.F90 @@ -113,7 +113,7 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -123,9 +123,9 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -150,13 +150,13 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswapdata_vect @@ -175,7 +175,7 @@ end subroutine psi_dswapdata_vect ! ! ! -subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_dswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dswap_vidx_vect @@ -192,7 +192,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -203,7 +203,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -218,10 +218,10 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -265,7 +265,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & nesd = idx%v(pnti+nerv+psb_n_elem_send_) rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_double_swap_tag @@ -418,7 +418,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswap_vidx_vect @@ -455,7 +455,7 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -465,9 +465,9 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -492,13 +492,13 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswapdata_multivect @@ -517,7 +517,7 @@ end subroutine psi_dswapdata_multivect ! ! ! -subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_dswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dswap_vidx_multivect @@ -534,7 +534,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -545,7 +545,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -560,10 +560,10 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -609,7 +609,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_double_swap_tag @@ -766,7 +766,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswap_vidx_multivect diff --git a/base/comm/internals/psi_dswapdata_a.F90 b/base/comm/internals/psi_dswapdata_a.F90 index 65090ee7..b85b1c6d 100644 --- a/base/comm/internals/psi_dswapdata_a.F90 +++ b/base/comm/internals/psi_dswapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswapdatam -subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dswapidxm @@ -169,7 +169,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswapidxm @@ -582,7 +582,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswapdatav @@ -641,7 +641,7 @@ end subroutine psi_dswapdatav ! ! ! -subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_dswapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dswapidxv @@ -656,7 +656,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswapidxv diff --git a/base/comm/internals/psi_dswaptran.F90 b/base/comm/internals/psi_dswaptran.F90 index e3a784f4..de46ad03 100644 --- a/base/comm/internals/psi_dswaptran.F90 +++ b/base/comm/internals/psi_dswaptran.F90 @@ -115,7 +115,7 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -125,9 +125,9 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -152,13 +152,13 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswaptran_vect @@ -176,7 +176,7 @@ end subroutine psi_dswaptran_vect ! ! ! -subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_dtran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dtran_vidx_vect @@ -193,7 +193,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -204,7 +204,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -219,10 +219,10 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& snd_pt = 1+pnti+nerv+psb_n_elem_send_ rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& @@ -425,7 +425,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -466,7 +466,7 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -476,9 +476,9 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -503,13 +503,13 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswaptran_multivect @@ -528,7 +528,7 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! ! ! -subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_dtran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dtran_vidx_multivect @@ -545,7 +545,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -556,7 +556,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -571,10 +571,10 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -621,7 +621,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& @@ -781,7 +781,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/internals/psi_dswaptran_a.F90 b/base/comm/internals/psi_dswaptran_a.F90 index 56691df5..8bc7b82f 100644 --- a/base/comm/internals/psi_dswaptran_a.F90 +++ b/base/comm/internals/psi_dswaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswaptranm -subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_dtranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dtranidxm @@ -174,7 +174,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dtranidxm @@ -597,7 +597,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dswaptranv @@ -656,7 +656,7 @@ end subroutine psi_dswaptranv ! ! ! -subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_dtranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_dtranidxv @@ -671,7 +671,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_double_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_dtranidxv diff --git a/base/comm/internals/psi_eovrl_restr_a.f90 b/base/comm/internals/psi_eovrl_restr_a.f90 index 032844d9..cfd08936 100644 --- a/base/comm/internals/psi_eovrl_restr_a.f90 +++ b/base/comm/internals/psi_eovrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_eovrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eovrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_eovrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eovrl_restrr2 diff --git a/base/comm/internals/psi_eovrl_save_a.f90 b/base/comm/internals/psi_eovrl_save_a.f90 index 43bd5c9f..adcb981a 100644 --- a/base/comm/internals/psi_eovrl_save_a.f90 +++ b/base/comm/internals/psi_eovrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_eovrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eovrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_eovrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eovrl_saver2 diff --git a/base/comm/internals/psi_eovrl_upd_a.f90 b/base/comm/internals/psi_eovrl_upd_a.f90 index 2790f57c..c1427547 100644 --- a/base/comm/internals/psi_eovrl_upd_a.f90 +++ b/base/comm/internals/psi_eovrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_eovrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eovrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_eovrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eovrl_updr2 diff --git a/base/comm/internals/psi_eswapdata_a.F90 b/base/comm/internals/psi_eswapdata_a.F90 index 11f90f84..3dc1786e 100644 --- a/base/comm/internals/psi_eswapdata_a.F90 +++ b/base/comm/internals/psi_eswapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eswapdatam -subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_eswapidxm @@ -169,7 +169,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int8_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eswapidxm @@ -582,7 +582,7 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eswapdatav @@ -641,7 +641,7 @@ end subroutine psi_eswapdatav ! ! ! -subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_eswapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_eswapidxv @@ -656,7 +656,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int8_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_eswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eswapidxv diff --git a/base/comm/internals/psi_eswaptran_a.F90 b/base/comm/internals/psi_eswaptran_a.F90 index 01251a4b..11419613 100644 --- a/base/comm/internals/psi_eswaptran_a.F90 +++ b/base/comm/internals/psi_eswaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eswaptranm -subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_etranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_etranidxm @@ -174,7 +174,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int8_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_etranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_etranidxm @@ -597,7 +597,7 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_eswaptranv @@ -656,7 +656,7 @@ end subroutine psi_eswaptranv ! ! ! -subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_etranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_etranidxv @@ -671,7 +671,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int8_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_etranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_etranidxv diff --git a/base/comm/internals/psi_i2ovrl_restr_a.f90 b/base/comm/internals/psi_i2ovrl_restr_a.f90 index dbed16ab..acb6b25d 100644 --- a/base/comm/internals/psi_i2ovrl_restr_a.f90 +++ b/base/comm/internals/psi_i2ovrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_i2ovrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2ovrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_i2ovrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2ovrl_restrr2 diff --git a/base/comm/internals/psi_i2ovrl_save_a.f90 b/base/comm/internals/psi_i2ovrl_save_a.f90 index fe30ab1f..dc0b3f54 100644 --- a/base/comm/internals/psi_i2ovrl_save_a.f90 +++ b/base/comm/internals/psi_i2ovrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_i2ovrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2ovrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_i2ovrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2ovrl_saver2 diff --git a/base/comm/internals/psi_i2ovrl_upd_a.f90 b/base/comm/internals/psi_i2ovrl_upd_a.f90 index ba6f900d..973ffa8e 100644 --- a/base/comm/internals/psi_i2ovrl_upd_a.f90 +++ b/base/comm/internals/psi_i2ovrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_i2ovrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2ovrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_i2ovrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2ovrl_updr2 diff --git a/base/comm/internals/psi_i2swapdata_a.F90 b/base/comm/internals/psi_i2swapdata_a.F90 index 82e15591..6d1928d3 100644 --- a/base/comm/internals/psi_i2swapdata_a.F90 +++ b/base/comm/internals/psi_i2swapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2swapdatam -subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_i2swapidxm @@ -169,7 +169,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int2_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2swapidxm @@ -582,7 +582,7 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2swapdatav @@ -641,7 +641,7 @@ end subroutine psi_i2swapdatav ! ! ! -subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_i2swapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_i2swapidxv @@ -656,7 +656,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int2_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_i2swapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2swapidxv diff --git a/base/comm/internals/psi_i2swaptran_a.F90 b/base/comm/internals/psi_i2swaptran_a.F90 index 06f08cab..26f3c820 100644 --- a/base/comm/internals/psi_i2swaptran_a.F90 +++ b/base/comm/internals/psi_i2swaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2swaptranm -subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_i2tranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_i2tranidxm @@ -174,7 +174,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int2_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_i2tranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2tranidxm @@ -597,7 +597,7 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2swaptranv @@ -656,7 +656,7 @@ end subroutine psi_i2swaptranv ! ! ! -subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_i2tranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_i2tranidxv @@ -671,7 +671,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int2_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_i2tranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_i2tranidxv diff --git a/base/comm/internals/psi_iovrl_restr.f90 b/base/comm/internals/psi_iovrl_restr.f90 index f407c91d..4059f508 100644 --- a/base/comm/internals/psi_iovrl_restr.f90 +++ b/base/comm/internals/psi_iovrl_restr.f90 @@ -47,7 +47,7 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -72,7 +72,7 @@ subroutine psi_iovrl_restr_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iovrl_restr_vect @@ -90,7 +90,7 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -100,8 +100,8 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,7 +114,7 @@ subroutine psi_iovrl_restr_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iovrl_restr_multivect diff --git a/base/comm/internals/psi_iovrl_save.f90 b/base/comm/internals/psi_iovrl_save.f90 index 7ec0a0bc..0a9b13fd 100644 --- a/base/comm/internals/psi_iovrl_save.f90 +++ b/base/comm/internals/psi_iovrl_save.f90 @@ -47,7 +47,7 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -78,7 +78,7 @@ subroutine psi_iovrl_save_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iovrl_save_vect @@ -96,7 +96,7 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -106,8 +106,8 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -128,7 +128,7 @@ subroutine psi_iovrl_save_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iovrl_save_multivect diff --git a/base/comm/internals/psi_iovrl_upd.f90 b/base/comm/internals/psi_iovrl_upd.f90 index 1a26c87c..4eefe131 100644 --- a/base/comm/internals/psi_iovrl_upd.f90 +++ b/base/comm/internals/psi_iovrl_upd.f90 @@ -50,7 +50,7 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info) ! locals integer(psb_ipk_), allocatable :: xs(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -62,8 +62,8 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -113,7 +113,7 @@ subroutine psi_iovrl_upd_vect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iovrl_upd_vect @@ -132,7 +132,7 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info) ! locals integer(psb_ipk_), allocatable :: xs(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -144,8 +144,8 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -196,7 +196,7 @@ subroutine psi_iovrl_upd_multivect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iovrl_upd_multivect diff --git a/base/comm/internals/psi_iswapdata.F90 b/base/comm/internals/psi_iswapdata.F90 index e9b8fa3d..e541ff6d 100644 --- a/base/comm/internals/psi_iswapdata.F90 +++ b/base/comm/internals/psi_iswapdata.F90 @@ -113,7 +113,7 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -123,9 +123,9 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -150,13 +150,13 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iswapdata_vect @@ -175,7 +175,7 @@ end subroutine psi_iswapdata_vect ! ! ! -subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_iswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_iswap_vidx_vect @@ -192,7 +192,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -203,7 +203,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -218,10 +218,10 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -265,7 +265,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & nesd = idx%v(pnti+nerv+psb_n_elem_send_) rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_int_swap_tag @@ -418,7 +418,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iswap_vidx_vect @@ -455,7 +455,7 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -465,9 +465,9 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -492,13 +492,13 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iswapdata_multivect @@ -517,7 +517,7 @@ end subroutine psi_iswapdata_multivect ! ! ! -subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_iswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_iswap_vidx_multivect @@ -534,7 +534,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -545,7 +545,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -560,10 +560,10 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -609,7 +609,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_int_swap_tag @@ -766,7 +766,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iswap_vidx_multivect diff --git a/base/comm/internals/psi_iswaptran.F90 b/base/comm/internals/psi_iswaptran.F90 index 21c37e5c..46bb18b5 100644 --- a/base/comm/internals/psi_iswaptran.F90 +++ b/base/comm/internals/psi_iswaptran.F90 @@ -115,7 +115,7 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -125,9 +125,9 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -152,13 +152,13 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iswaptran_vect @@ -176,7 +176,7 @@ end subroutine psi_iswaptran_vect ! ! ! -subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_itran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_itran_vidx_vect @@ -193,7 +193,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -204,7 +204,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -219,10 +219,10 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& snd_pt = 1+pnti+nerv+psb_n_elem_send_ rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& @@ -425,7 +425,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -466,7 +466,7 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -476,9 +476,9 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -503,13 +503,13 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_iswaptran_multivect @@ -528,7 +528,7 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! ! ! -subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_itran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_itran_vidx_multivect @@ -545,7 +545,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -556,7 +556,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -571,10 +571,10 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -621,7 +621,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& @@ -781,7 +781,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/internals/psi_lovrl_restr.f90 b/base/comm/internals/psi_lovrl_restr.f90 index 2bb78d63..71871e70 100644 --- a/base/comm/internals/psi_lovrl_restr.f90 +++ b/base/comm/internals/psi_lovrl_restr.f90 @@ -47,7 +47,7 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -72,7 +72,7 @@ subroutine psi_lovrl_restr_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lovrl_restr_vect @@ -90,7 +90,7 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -100,8 +100,8 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,7 +114,7 @@ subroutine psi_lovrl_restr_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lovrl_restr_multivect diff --git a/base/comm/internals/psi_lovrl_save.f90 b/base/comm/internals/psi_lovrl_save.f90 index 3fceef89..29d3b0ad 100644 --- a/base/comm/internals/psi_lovrl_save.f90 +++ b/base/comm/internals/psi_lovrl_save.f90 @@ -47,7 +47,7 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -78,7 +78,7 @@ subroutine psi_lovrl_save_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lovrl_save_vect @@ -96,7 +96,7 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -106,8 +106,8 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -128,7 +128,7 @@ subroutine psi_lovrl_save_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lovrl_save_multivect diff --git a/base/comm/internals/psi_lovrl_upd.f90 b/base/comm/internals/psi_lovrl_upd.f90 index 22837b89..d8b4bb5a 100644 --- a/base/comm/internals/psi_lovrl_upd.f90 +++ b/base/comm/internals/psi_lovrl_upd.f90 @@ -50,7 +50,7 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info) ! locals integer(psb_lpk_), allocatable :: xs(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -62,8 +62,8 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -113,7 +113,7 @@ subroutine psi_lovrl_upd_vect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lovrl_upd_vect @@ -132,7 +132,7 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info) ! locals integer(psb_lpk_), allocatable :: xs(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -144,8 +144,8 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -196,7 +196,7 @@ subroutine psi_lovrl_upd_multivect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lovrl_upd_multivect diff --git a/base/comm/internals/psi_lswapdata.F90 b/base/comm/internals/psi_lswapdata.F90 index 6106659a..088c6508 100644 --- a/base/comm/internals/psi_lswapdata.F90 +++ b/base/comm/internals/psi_lswapdata.F90 @@ -113,7 +113,7 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -123,9 +123,9 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -150,13 +150,13 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lswapdata_vect @@ -175,7 +175,7 @@ end subroutine psi_lswapdata_vect ! ! ! -subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_lswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_lswap_vidx_vect @@ -192,7 +192,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -203,7 +203,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -218,10 +218,10 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -265,7 +265,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & nesd = idx%v(pnti+nerv+psb_n_elem_send_) rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_long_swap_tag @@ -418,7 +418,7 @@ subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lswap_vidx_vect @@ -455,7 +455,7 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -465,9 +465,9 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -492,13 +492,13 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lswapdata_multivect @@ -517,7 +517,7 @@ end subroutine psi_lswapdata_multivect ! ! ! -subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_lswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_lswap_vidx_multivect @@ -534,7 +534,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -545,7 +545,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -560,10 +560,10 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -609,7 +609,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_long_swap_tag @@ -766,7 +766,7 @@ subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lswap_vidx_multivect diff --git a/base/comm/internals/psi_lswaptran.F90 b/base/comm/internals/psi_lswaptran.F90 index e0bf6c00..60470169 100644 --- a/base/comm/internals/psi_lswaptran.F90 +++ b/base/comm/internals/psi_lswaptran.F90 @@ -115,7 +115,7 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -125,9 +125,9 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -152,13 +152,13 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lswaptran_vect @@ -176,7 +176,7 @@ end subroutine psi_lswaptran_vect ! ! ! -subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ltran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ltran_vidx_vect @@ -193,7 +193,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -204,7 +204,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -219,10 +219,10 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& snd_pt = 1+pnti+nerv+psb_n_elem_send_ rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& @@ -425,7 +425,7 @@ subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -466,7 +466,7 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -476,9 +476,9 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -503,13 +503,13 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_lswaptran_multivect @@ -528,7 +528,7 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! ! ! -subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ltran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ltran_vidx_multivect @@ -545,7 +545,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -556,7 +556,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -571,10 +571,10 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -621,7 +621,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& @@ -781,7 +781,7 @@ subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/internals/psi_movrl_restr_a.f90 b/base/comm/internals/psi_movrl_restr_a.f90 index 92717599..d884ad63 100644 --- a/base/comm/internals/psi_movrl_restr_a.f90 +++ b/base/comm/internals/psi_movrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_movrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_movrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_movrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_movrl_restrr2 diff --git a/base/comm/internals/psi_movrl_save_a.f90 b/base/comm/internals/psi_movrl_save_a.f90 index 20c1d0e7..398ea24a 100644 --- a/base/comm/internals/psi_movrl_save_a.f90 +++ b/base/comm/internals/psi_movrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_movrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_movrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_movrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_movrl_saver2 diff --git a/base/comm/internals/psi_movrl_upd_a.f90 b/base/comm/internals/psi_movrl_upd_a.f90 index a935452e..c4ffa64f 100644 --- a/base/comm/internals/psi_movrl_upd_a.f90 +++ b/base/comm/internals/psi_movrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_movrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_movrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_movrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_movrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_movrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_movrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_movrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_movrl_updr2 diff --git a/base/comm/internals/psi_mswapdata_a.F90 b/base/comm/internals/psi_mswapdata_a.F90 index bf2908d5..8e86c515 100644 --- a/base/comm/internals/psi_mswapdata_a.F90 +++ b/base/comm/internals/psi_mswapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mswapdatam -subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_mswapidxm @@ -169,7 +169,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int4_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mswapidxm @@ -582,7 +582,7 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mswapdatav @@ -641,7 +641,7 @@ end subroutine psi_mswapdatav ! ! ! -subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_mswapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_mswapidxv @@ -656,7 +656,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_int4_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_mswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mswapidxv diff --git a/base/comm/internals/psi_mswaptran_a.F90 b/base/comm/internals/psi_mswaptran_a.F90 index e04b5307..65b8e367 100644 --- a/base/comm/internals/psi_mswaptran_a.F90 +++ b/base/comm/internals/psi_mswaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mswaptranm -subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_mtranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_mtranidxm @@ -174,7 +174,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int4_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_mtranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mtranidxm @@ -597,7 +597,7 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mswaptranv @@ -656,7 +656,7 @@ end subroutine psi_mswaptranv ! ! ! -subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_mtranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_mtranidxv @@ -671,7 +671,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_int4_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_mtranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_mtranidxv diff --git a/base/comm/internals/psi_sovrl_restr.f90 b/base/comm/internals/psi_sovrl_restr.f90 index d577da9c..f51d98e2 100644 --- a/base/comm/internals/psi_sovrl_restr.f90 +++ b/base/comm/internals/psi_sovrl_restr.f90 @@ -47,7 +47,7 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -72,7 +72,7 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_restr_vect @@ -90,7 +90,7 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -100,8 +100,8 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,7 +114,7 @@ subroutine psi_sovrl_restr_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_restr_multivect diff --git a/base/comm/internals/psi_sovrl_restr_a.f90 b/base/comm/internals/psi_sovrl_restr_a.f90 index 5cf91e35..c1295187 100644 --- a/base/comm/internals/psi_sovrl_restr_a.f90 +++ b/base/comm/internals/psi_sovrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_sovrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_restrr2 diff --git a/base/comm/internals/psi_sovrl_save.f90 b/base/comm/internals/psi_sovrl_save.f90 index 39344e08..04fc3350 100644 --- a/base/comm/internals/psi_sovrl_save.f90 +++ b/base/comm/internals/psi_sovrl_save.f90 @@ -47,7 +47,7 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -78,7 +78,7 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_save_vect @@ -96,7 +96,7 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -106,8 +106,8 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -128,7 +128,7 @@ subroutine psi_sovrl_save_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_save_multivect diff --git a/base/comm/internals/psi_sovrl_save_a.f90 b/base/comm/internals/psi_sovrl_save_a.f90 index 4b78186f..e2b57541 100644 --- a/base/comm/internals/psi_sovrl_save_a.f90 +++ b/base/comm/internals/psi_sovrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_sovrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_saver2 diff --git a/base/comm/internals/psi_sovrl_upd.f90 b/base/comm/internals/psi_sovrl_upd.f90 index fa08e0aa..046524ff 100644 --- a/base/comm/internals/psi_sovrl_upd.f90 +++ b/base/comm/internals/psi_sovrl_upd.f90 @@ -50,7 +50,7 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -62,8 +62,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -113,7 +113,7 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_upd_vect @@ -132,7 +132,7 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -144,8 +144,8 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -196,7 +196,7 @@ subroutine psi_sovrl_upd_multivect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_upd_multivect diff --git a/base/comm/internals/psi_sovrl_upd_a.f90 b/base/comm/internals/psi_sovrl_upd_a.f90 index d8d91670..4387492d 100644 --- a/base/comm/internals/psi_sovrl_upd_a.f90 +++ b/base/comm/internals/psi_sovrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sovrl_updr2 diff --git a/base/comm/internals/psi_sswapdata.F90 b/base/comm/internals/psi_sswapdata.F90 index 0f27d260..307195bb 100644 --- a/base/comm/internals/psi_sswapdata.F90 +++ b/base/comm/internals/psi_sswapdata.F90 @@ -113,7 +113,7 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -123,9 +123,9 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -150,13 +150,13 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswapdata_vect @@ -175,7 +175,7 @@ end subroutine psi_sswapdata_vect ! ! ! -subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_sswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_sswap_vidx_vect @@ -192,7 +192,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -203,7 +203,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -218,10 +218,10 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -265,7 +265,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & nesd = idx%v(pnti+nerv+psb_n_elem_send_) rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_real_swap_tag @@ -418,7 +418,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswap_vidx_vect @@ -455,7 +455,7 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -465,9 +465,9 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -492,13 +492,13 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswapdata_multivect @@ -517,7 +517,7 @@ end subroutine psi_sswapdata_multivect ! ! ! -subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_sswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_sswap_vidx_multivect @@ -534,7 +534,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -545,7 +545,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -560,10 +560,10 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -609,7 +609,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_real_swap_tag @@ -766,7 +766,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswap_vidx_multivect diff --git a/base/comm/internals/psi_sswapdata_a.F90 b/base/comm/internals/psi_sswapdata_a.F90 index ce9bbbe8..6d74e1ad 100644 --- a/base/comm/internals/psi_sswapdata_a.F90 +++ b/base/comm/internals/psi_sswapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswapdatam -subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_sswapidxm @@ -169,7 +169,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswapidxm @@ -582,7 +582,7 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswapdatav @@ -641,7 +641,7 @@ end subroutine psi_sswapdatav ! ! ! -subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_sswapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_sswapidxv @@ -656,7 +656,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswapidxv diff --git a/base/comm/internals/psi_sswaptran.F90 b/base/comm/internals/psi_sswaptran.F90 index 69f6b95d..25aa5303 100644 --- a/base/comm/internals/psi_sswaptran.F90 +++ b/base/comm/internals/psi_sswaptran.F90 @@ -115,7 +115,7 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -125,9 +125,9 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -152,13 +152,13 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswaptran_vect @@ -176,7 +176,7 @@ end subroutine psi_sswaptran_vect ! ! ! -subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_stran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_stran_vidx_vect @@ -193,7 +193,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -204,7 +204,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -219,10 +219,10 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& snd_pt = 1+pnti+nerv+psb_n_elem_send_ rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& @@ -425,7 +425,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -466,7 +466,7 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -476,9 +476,9 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -503,13 +503,13 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswaptran_multivect @@ -528,7 +528,7 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! ! ! -subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_stran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_stran_vidx_multivect @@ -545,7 +545,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -556,7 +556,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -571,10 +571,10 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -621,7 +621,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& @@ -781,7 +781,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/internals/psi_sswaptran_a.F90 b/base/comm/internals/psi_sswaptran_a.F90 index 18142908..866456d4 100644 --- a/base/comm/internals/psi_sswaptran_a.F90 +++ b/base/comm/internals/psi_sswaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswaptranm -subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_stranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_stranidxm @@ -174,7 +174,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_stranidxm @@ -597,7 +597,7 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_sswaptranv @@ -656,7 +656,7 @@ end subroutine psi_sswaptranv ! ! ! -subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_stranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_stranidxv @@ -671,7 +671,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_real_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_stranidxv diff --git a/base/comm/internals/psi_zovrl_restr.f90 b/base/comm/internals/psi_zovrl_restr.f90 index b9cb1a8a..0b127c3e 100644 --- a/base/comm/internals/psi_zovrl_restr.f90 +++ b/base/comm/internals/psi_zovrl_restr.f90 @@ -47,7 +47,7 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -72,7 +72,7 @@ subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_restr_vect @@ -90,7 +90,7 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -100,8 +100,8 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,7 +114,7 @@ subroutine psi_zovrl_restr_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_restr_multivect diff --git a/base/comm/internals/psi_zovrl_restr_a.f90 b/base/comm/internals/psi_zovrl_restr_a.f90 index 34409387..a823b73d 100644 --- a/base/comm/internals/psi_zovrl_restr_a.f90 +++ b/base/comm/internals/psi_zovrl_restr_a.f90 @@ -45,7 +45,7 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -55,8 +55,8 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -73,7 +73,7 @@ subroutine psi_zovrl_restrr1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_restrr1 @@ -89,7 +89,7 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -99,8 +99,8 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psi_zovrl_restrr2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_restrr2 diff --git a/base/comm/internals/psi_zovrl_save.f90 b/base/comm/internals/psi_zovrl_save.f90 index e8f88f5a..830479fe 100644 --- a/base/comm/internals/psi_zovrl_save.f90 +++ b/base/comm/internals/psi_zovrl_save.f90 @@ -47,7 +47,7 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -78,7 +78,7 @@ subroutine psi_zovrl_save_vect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_save_vect @@ -96,7 +96,7 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -106,8 +106,8 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -128,7 +128,7 @@ subroutine psi_zovrl_save_multivect(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_save_multivect diff --git a/base/comm/internals/psi_zovrl_save_a.f90 b/base/comm/internals/psi_zovrl_save_a.f90 index fbb108a9..f2c09ee8 100644 --- a/base/comm/internals/psi_zovrl_save_a.f90 +++ b/base/comm/internals/psi_zovrl_save_a.f90 @@ -47,7 +47,7 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -81,7 +81,7 @@ subroutine psi_zovrl_saver1(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_saver1 @@ -100,7 +100,7 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, isz, nc character(len=20) :: name, ch_err @@ -110,8 +110,8 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -135,7 +135,7 @@ subroutine psi_zovrl_saver2(x,xs,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_saver2 diff --git a/base/comm/internals/psi_zovrl_upd.f90 b/base/comm/internals/psi_zovrl_upd.f90 index f18e914d..f71862f7 100644 --- a/base/comm/internals/psi_zovrl_upd.f90 +++ b/base/comm/internals/psi_zovrl_upd.f90 @@ -50,7 +50,7 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -62,8 +62,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -113,7 +113,7 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_upd_vect @@ -132,7 +132,7 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm, nx, nc integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -144,8 +144,8 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -196,7 +196,7 @@ subroutine psi_zovrl_upd_multivect(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_upd_multivect diff --git a/base/comm/internals/psi_zovrl_upd_a.f90 b/base/comm/internals/psi_zovrl_upd_a.f90 index ed775e4c..658bd317 100644 --- a/base/comm/internals/psi_zovrl_upd_a.f90 +++ b/base/comm/internals/psi_zovrl_upd_a.f90 @@ -46,7 +46,7 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -57,8 +57,8 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_updr1 @@ -115,7 +115,7 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, i, idx, ndm integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -126,8 +126,8 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -168,7 +168,7 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zovrl_updr2 diff --git a/base/comm/internals/psi_zswapdata.F90 b/base/comm/internals/psi_zswapdata.F90 index fbf17803..e892a795 100644 --- a/base/comm/internals/psi_zswapdata.F90 +++ b/base/comm/internals/psi_zswapdata.F90 @@ -113,7 +113,7 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -123,9 +123,9 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -150,13 +150,13 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswapdata_vect @@ -175,7 +175,7 @@ end subroutine psi_zswapdata_vect ! ! ! -subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_zswap_vidx_vect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_zswap_vidx_vect @@ -192,7 +192,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -203,7 +203,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -218,10 +218,10 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -265,7 +265,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & nesd = idx%v(pnti+nerv+psb_n_elem_send_) rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_dcomplex_swap_tag @@ -418,7 +418,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswap_vidx_vect @@ -455,7 +455,7 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act class(psb_i_base_vect_type), pointer :: d_vidx @@ -465,9 +465,9 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -492,13 +492,13 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswapdata_multivect @@ -517,7 +517,7 @@ end subroutine psi_zswapdata_multivect ! ! ! -subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_zswap_vidx_multivect(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_zswap_vidx_multivect @@ -534,7 +534,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -545,7 +545,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -560,10 +560,10 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -609,7 +609,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt p2ptag = psb_dcomplex_swap_tag @@ -766,7 +766,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswap_vidx_multivect diff --git a/base/comm/internals/psi_zswapdata_a.F90 b/base/comm/internals/psi_zswapdata_a.F90 index ea2e69ab..25e1a991 100644 --- a/base/comm/internals/psi_zswapdata_a.F90 +++ b/base/comm/internals/psi_zswapdata_a.F90 @@ -106,7 +106,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -116,9 +116,9 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_data' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -143,18 +143,18 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswapdatam -subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & +subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_zswapidxm @@ -169,7 +169,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -198,7 +198,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & name='psi_swap_data' call psb_erractionsave(err_act) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -238,7 +238,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -317,14 +317,14 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -351,7 +351,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),n*nerv,& @@ -436,7 +436,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -453,7 +453,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -501,7 +501,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswapidxm @@ -582,7 +582,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act integer(psb_ipk_), pointer :: d_idx(:) @@ -592,9 +592,9 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -619,13 +619,13 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swapdata(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswapdatav @@ -641,7 +641,7 @@ end subroutine psi_zswapdatav ! ! ! -subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & +subroutine psi_zswapidxv(ictxt,iicomm,flag,beta,y,idx, & & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_zswapidxv @@ -656,7 +656,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -665,7 +665,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -684,10 +684,10 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & info=psb_success_ name='psi_swap_datav' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -727,7 +727,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -807,14 +807,14 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm > me) then - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -841,7 +841,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nerv>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(rcvbuf(rcv_pt),nerv,& @@ -925,7 +925,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_snd(ictxt,& + if (nesd>0) call psb_snd(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -941,7 +941,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_rcv(ictxt,& + if (nerv>0) call psb_rcv(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -988,7 +988,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, & call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswapidxv diff --git a/base/comm/internals/psi_zswaptran.F90 b/base/comm/internals/psi_zswaptran.F90 index ab1889f0..74fc4221 100644 --- a/base/comm/internals/psi_zswaptran.F90 +++ b/base/comm/internals/psi_zswaptran.F90 @@ -115,7 +115,7 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -125,9 +125,9 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -152,13 +152,13 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswaptran_vect @@ -176,7 +176,7 @@ end subroutine psi_zswaptran_vect ! ! ! -subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ztran_vidx_vect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ztran_vidx_vect @@ -193,7 +193,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -204,7 +204,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -219,10 +219,10 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& snd_pt = 1+pnti+nerv+psb_n_elem_send_ rcv_pt = 1+pnti+psb_n_elem_recv_ - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),rcv_pt call mpi_irecv(y%combuf(snd_pt),nesd,& @@ -425,7 +425,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -466,7 +466,7 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ class(psb_i_base_vect_type), pointer :: d_vidx @@ -476,9 +476,9 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -503,13 +503,13 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswaptran_multivect @@ -528,7 +528,7 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data) ! ! ! -subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ztran_vidx_multivect(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ztran_vidx_multivect @@ -545,7 +545,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -556,7 +556,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable :: prcid(:) @@ -571,10 +571,10 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -621,7 +621,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx%v(pnti+psb_proc_id_) nerv = idx%v(pnti+psb_n_elem_recv_) nesd = idx%v(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then if (debug) write(*,*) me,'Posting receive from',prcid(i),snd_pt call mpi_irecv(y%combuf(snd_pt),n*nesd,& @@ -781,7 +781,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/internals/psi_zswaptran_a.F90 b/base/comm/internals/psi_zswaptran_a.F90 index 8625ea71..4984b51b 100644 --- a/base/comm/internals/psi_zswaptran_a.F90 +++ b/base/comm/internals/psi_zswaptran_a.F90 @@ -110,7 +110,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, err_act, totxch, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -120,10 +120,10 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -148,18 +148,18 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,n,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswaptranm -subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& +subroutine psi_ztranidxm(ictxt,iicomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ztranidxm @@ -174,7 +174,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag,n integer(psb_ipk_), intent(out) :: info @@ -183,7 +183,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -202,10 +202,10 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -245,7 +245,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = n*nerv @@ -329,14 +329,14 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -363,7 +363,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(sndbuf(snd_pt),n*nesd,& @@ -448,7 +448,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -465,7 +465,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) rcv_pt = rcv_pt + n*nerv snd_pt = snd_pt + n*nesd @@ -513,7 +513,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_ztranidxm @@ -597,7 +597,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) integer(psb_ipk_), optional :: data ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np, me, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_), pointer :: d_idx(:) @@ -607,9 +607,9 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) name='psi_swap_tranv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -634,13 +634,13 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) goto 9999 end if - call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + call psi_swaptran(ctxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_zswaptranv @@ -656,7 +656,7 @@ end subroutine psi_zswaptranv ! ! ! -subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& +subroutine psi_ztranidxv(ictxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) use psi_mod, psb_protect_name => psi_ztranidxv @@ -671,7 +671,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ictxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -680,7 +680,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm, np, me,& & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret integer(psb_mpk_), allocatable, dimension(:) :: bsdidx, brvidx,& @@ -699,10 +699,10 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& info=psb_success_ name='psi_swap_tran' call psb_erractionsave(err_act) - ictxt = iictxt + ctxt = ictxt icomm = iicomm - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -742,7 +742,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(proc_to_comm) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(proc_to_comm) = psb_get_mpi_rank(ctxt,proc_to_comm) brvidx(proc_to_comm) = rcv_pt rvsz(proc_to_comm) = nerv @@ -827,14 +827,14 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& nesd = idx(pnti+nerv+psb_n_elem_send_) if (proc_to_comm < me) then - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm > me) then - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then @@ -860,7 +860,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - prcid(i) = psb_get_mpi_rank(ictxt,proc_to_comm) + prcid(i) = psb_get_mpi_rank(ctxt,proc_to_comm) if ((nesd>0).and.(proc_to_comm /= me)) then p2ptag = psb_dcomplex_swap_tag call mpi_irecv(sndbuf(snd_pt),nesd,& @@ -943,7 +943,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nerv>0) call psb_snd(ictxt,& + if (nerv>0) call psb_snd(ctxt,& & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -959,7 +959,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& proc_to_comm = idx(pnti+psb_proc_id_) nerv = idx(pnti+psb_n_elem_recv_) nesd = idx(pnti+nerv+psb_n_elem_send_) - if (nesd>0) call psb_rcv(ictxt,& + if (nesd>0) call psb_rcv(ctxt,& & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) rcv_pt = rcv_pt + nerv snd_pt = snd_pt + nesd @@ -1006,7 +1006,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_ztranidxv diff --git a/base/comm/psb_cgather.f90 b/base/comm/psb_cgather.f90 index 0980d128..7893d7c3 100644 --- a/base/comm/psb_cgather.f90 +++ b/base/comm/psb_cgather.f90 @@ -57,7 +57,7 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -71,10 +71,10 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -149,12 +149,12 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -175,7 +175,7 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -189,10 +189,10 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -266,12 +266,12 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_cgather_a.f90 b/base/comm/psb_cgather_a.f90 index ed32bf8c..ac2e66e4 100644 --- a/base/comm/psb_cgather_a.f90 +++ b/base/comm/psb_cgather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_chalo.f90 b/base/comm/psb_chalo.f90 index 675c42ef..7eca2d12 100644 --- a/base/comm/psb_chalo.f90 +++ b/base/comm/psb_chalo.f90 @@ -65,7 +65,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -81,10 +81,10 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -180,7 +180,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_chalo_vect @@ -220,7 +220,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -236,10 +236,10 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -336,7 +336,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_chalo_multivect diff --git a/base/comm/psb_chalo_a.f90 b/base/comm/psb_chalo_a.f90 index 010e152a..b27ffe56 100644 --- a/base/comm/psb_chalo_a.f90 +++ b/base/comm/psb_chalo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_chalom @@ -267,7 +267,7 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_chalov diff --git a/base/comm/psb_covrl.f90 b/base/comm/psb_covrl.f90 index ba8de110..6ae6ce9f 100644 --- a/base/comm/psb_covrl.f90 +++ b/base/comm/psb_covrl.f90 @@ -75,7 +75,7 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -91,10 +91,10 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -176,7 +176,7 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_covrl_vect @@ -225,7 +225,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -241,10 +241,10 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -328,7 +328,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_covrl_multivect diff --git a/base/comm/psb_covrl_a.f90 b/base/comm/psb_covrl_a.f90 index b661c01e..d0f079ae 100644 --- a/base/comm/psb_covrl_a.f90 +++ b/base/comm/psb_covrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_covrlm @@ -266,7 +266,7 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_covrlv diff --git a/base/comm/psb_cscatter.F90 b/base/comm/psb_cscatter.F90 index 288becd1..8d1235db 100644 --- a/base/comm/psb_cscatter.F90 +++ b/base/comm/psb_cscatter.F90 @@ -54,7 +54,7 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_c_base_vect_type), intent(in), optional :: mold ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -68,13 +68,13 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -93,7 +93,7 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_cscatter_a.F90 b/base/comm/psb_cscatter_a.F90 index 11f6ad5e..38d922e2 100644 --- a/base/comm/psb_cscatter_a.F90 +++ b/base/comm/psb_cscatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index e46706d8..9d50ef56 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -67,7 +67,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -83,9 +83,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -129,7 +129,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) nzg = sum(nzbr) if (nzg <0) then info = psb_err_mpi_int_ovflw_ @@ -217,7 +217,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -250,7 +250,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -266,9 +266,9 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -310,7 +310,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -390,7 +390,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -422,7 +422,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -438,9 +438,9 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -482,7 +482,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -557,7 +557,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_dgather.f90 b/base/comm/psb_dgather.f90 index d1dc27c1..8109d506 100644 --- a/base/comm/psb_dgather.f90 +++ b/base/comm/psb_dgather.f90 @@ -57,7 +57,7 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -71,10 +71,10 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -149,12 +149,12 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -175,7 +175,7 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -189,10 +189,10 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -266,12 +266,12 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_dgather_a.f90 b/base/comm/psb_dgather_a.f90 index 5ff78165..1e03ccfd 100644 --- a/base/comm/psb_dgather_a.f90 +++ b/base/comm/psb_dgather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_dhalo.f90 b/base/comm/psb_dhalo.f90 index 65d92dd5..080631e1 100644 --- a/base/comm/psb_dhalo.f90 +++ b/base/comm/psb_dhalo.f90 @@ -65,7 +65,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -81,10 +81,10 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -180,7 +180,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dhalo_vect @@ -220,7 +220,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -236,10 +236,10 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -336,7 +336,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dhalo_multivect diff --git a/base/comm/psb_dhalo_a.f90 b/base/comm/psb_dhalo_a.f90 index d1963f09..ccbc169d 100644 --- a/base/comm/psb_dhalo_a.f90 +++ b/base/comm/psb_dhalo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dhalom @@ -267,7 +267,7 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dhalov diff --git a/base/comm/psb_dovrl.f90 b/base/comm/psb_dovrl.f90 index 2a6dbefe..f0905278 100644 --- a/base/comm/psb_dovrl.f90 +++ b/base/comm/psb_dovrl.f90 @@ -75,7 +75,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -91,10 +91,10 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -176,7 +176,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dovrl_vect @@ -225,7 +225,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -241,10 +241,10 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -328,7 +328,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dovrl_multivect diff --git a/base/comm/psb_dovrl_a.f90 b/base/comm/psb_dovrl_a.f90 index 7d2821a9..e005a393 100644 --- a/base/comm/psb_dovrl_a.f90 +++ b/base/comm/psb_dovrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dovrlm @@ -266,7 +266,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dovrlv diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 5ca8ebaa..3465333b 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -54,7 +54,7 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_d_base_vect_type), intent(in), optional :: mold ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -68,13 +68,13 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -93,7 +93,7 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_dscatter_a.F90 b/base/comm/psb_dscatter_a.F90 index 6f09e5e3..0f3be5aa 100644 --- a/base/comm/psb_dscatter_a.F90 +++ b/base/comm/psb_dscatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index bacf07ab..13d04d7b 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -67,7 +67,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -83,9 +83,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -129,7 +129,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) nzg = sum(nzbr) if (nzg <0) then info = psb_err_mpi_int_ovflw_ @@ -217,7 +217,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -250,7 +250,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -266,9 +266,9 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -310,7 +310,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -390,7 +390,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -422,7 +422,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -438,9 +438,9 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -482,7 +482,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -557,7 +557,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_egather_a.f90 b/base/comm/psb_egather_a.f90 index 4e3e3fe5..b777cebd 100644 --- a/base/comm/psb_egather_a.f90 +++ b/base/comm/psb_egather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_egatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_egatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_ehalo_a.f90 b/base/comm/psb_ehalo_a.f90 index b52a2316..03aa1e3f 100644 --- a/base/comm/psb_ehalo_a.f90 +++ b/base/comm/psb_ehalo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_ehalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ehalom @@ -267,7 +267,7 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_ehalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ehalov diff --git a/base/comm/psb_eovrl_a.f90 b/base/comm/psb_eovrl_a.f90 index 45cac36c..fc6a868d 100644 --- a/base/comm/psb_eovrl_a.f90 +++ b/base/comm/psb_eovrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_eovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_eovrlm @@ -266,7 +266,7 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_eovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_eovrlv diff --git a/base/comm/psb_escatter_a.F90 b/base/comm/psb_escatter_a.F90 index d07f63ad..e2b45f5c 100644 --- a/base/comm/psb_escatter_a.F90 +++ b/base/comm/psb_escatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_i2gather_a.f90 b/base/comm/psb_i2gather_a.f90 index 38053808..e0e1ed7a 100644 --- a/base/comm/psb_i2gather_a.f90 +++ b/base/comm/psb_i2gather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_i2gatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_i2gatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_i2halo_a.f90 b/base/comm/psb_i2halo_a.f90 index 6e0fefe0..d49d71c6 100644 --- a/base/comm/psb_i2halo_a.f90 +++ b/base/comm/psb_i2halo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_i2halom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_i2halom @@ -267,7 +267,7 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_i2halov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_i2halov diff --git a/base/comm/psb_i2ovrl_a.f90 b/base/comm/psb_i2ovrl_a.f90 index 1cd189c8..f7ccd7a6 100644 --- a/base/comm/psb_i2ovrl_a.f90 +++ b/base/comm/psb_i2ovrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_i2ovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_i2ovrlm @@ -266,7 +266,7 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_i2ovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_i2ovrlv diff --git a/base/comm/psb_i2scatter_a.F90 b/base/comm/psb_i2scatter_a.F90 index 3a6ba142..960e48b0 100644 --- a/base/comm/psb_i2scatter_a.F90 +++ b/base/comm/psb_i2scatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_igather.f90 b/base/comm/psb_igather.f90 index ec815de4..2a01ee44 100644 --- a/base/comm/psb_igather.f90 +++ b/base/comm/psb_igather.f90 @@ -57,7 +57,7 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -71,10 +71,10 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -149,12 +149,12 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -175,7 +175,7 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -189,10 +189,10 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -266,12 +266,12 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_ihalo.f90 b/base/comm/psb_ihalo.f90 index 61132bc5..57e52958 100644 --- a/base/comm/psb_ihalo.f90 +++ b/base/comm/psb_ihalo.f90 @@ -65,7 +65,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -81,10 +81,10 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -180,7 +180,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ihalo_vect @@ -220,7 +220,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -236,10 +236,10 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -336,7 +336,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ihalo_multivect diff --git a/base/comm/psb_iovrl.f90 b/base/comm/psb_iovrl.f90 index 7ca6068e..3dd459f1 100644 --- a/base/comm/psb_iovrl.f90 +++ b/base/comm/psb_iovrl.f90 @@ -75,7 +75,7 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -91,10 +91,10 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -176,7 +176,7 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_iovrl_vect @@ -225,7 +225,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -241,10 +241,10 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -328,7 +328,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_iovrl_multivect diff --git a/base/comm/psb_iscatter.F90 b/base/comm/psb_iscatter.F90 index 94dec0b0..57268e71 100644 --- a/base/comm/psb_iscatter.F90 +++ b/base/comm/psb_iscatter.F90 @@ -54,7 +54,7 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_i_base_vect_type), intent(in), optional :: mold ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -68,13 +68,13 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -93,7 +93,7 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_ispgather.F90 b/base/comm/psb_ispgather.F90 index 51d4a0de..e45f0f5d 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -67,7 +67,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -83,9 +83,9 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -129,7 +129,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) nzg = sum(nzbr) if (nzg <0) then info = psb_err_mpi_int_ovflw_ @@ -217,7 +217,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -250,7 +250,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -266,9 +266,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -310,7 +310,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -390,7 +390,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -422,7 +422,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -438,9 +438,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -482,7 +482,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -557,7 +557,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_lgather.f90 b/base/comm/psb_lgather.f90 index 4f7555b0..eeb5a25d 100644 --- a/base/comm/psb_lgather.f90 +++ b/base/comm/psb_lgather.f90 @@ -57,7 +57,7 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -71,10 +71,10 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -149,12 +149,12 @@ subroutine psb_lgather_vect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -175,7 +175,7 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -189,10 +189,10 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -266,12 +266,12 @@ subroutine psb_lgather_multivect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_lhalo.f90 b/base/comm/psb_lhalo.f90 index ae2235e7..3a188561 100644 --- a/base/comm/psb_lhalo.f90 +++ b/base/comm/psb_lhalo.f90 @@ -65,7 +65,7 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -81,10 +81,10 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -180,7 +180,7 @@ subroutine psb_lhalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_lhalo_vect @@ -220,7 +220,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -236,10 +236,10 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -336,7 +336,7 @@ subroutine psb_lhalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_lhalo_multivect diff --git a/base/comm/psb_lovrl.f90 b/base/comm/psb_lovrl.f90 index 38572d33..43de77bb 100644 --- a/base/comm/psb_lovrl.f90 +++ b/base/comm/psb_lovrl.f90 @@ -75,7 +75,7 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -91,10 +91,10 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -176,7 +176,7 @@ subroutine psb_lovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_lovrl_vect @@ -225,7 +225,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -241,10 +241,10 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -328,7 +328,7 @@ subroutine psb_lovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_lovrl_multivect diff --git a/base/comm/psb_lscatter.F90 b/base/comm/psb_lscatter.F90 index d161967a..0ebbe28e 100644 --- a/base/comm/psb_lscatter.F90 +++ b/base/comm/psb_lscatter.F90 @@ -54,7 +54,7 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_l_base_vect_type), intent(in), optional :: mold ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -68,13 +68,13 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -93,7 +93,7 @@ subroutine psb_lscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_lspgather.F90 b/base/comm/psb_lspgather.F90 index 6d5e6182..aa7b8fcc 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -67,7 +67,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -83,9 +83,9 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -129,7 +129,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) nzg = sum(nzbr) if (nzg <0) then info = psb_err_mpi_int_ovflw_ @@ -217,7 +217,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -250,7 +250,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -266,9 +266,9 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -310,7 +310,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -390,7 +390,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -422,7 +422,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -438,9 +438,9 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -482,7 +482,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -557,7 +557,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_mgather_a.f90 b/base/comm/psb_mgather_a.f90 index af3136ca..df574ea2 100644 --- a/base/comm/psb_mgather_a.f90 +++ b/base/comm/psb_mgather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_mgatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_mgatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_mgatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_mgatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_mhalo_a.f90 b/base/comm/psb_mhalo_a.f90 index 8b9502df..cb9ffec1 100644 --- a/base/comm/psb_mhalo_a.f90 +++ b/base/comm/psb_mhalo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_mhalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_mhalom @@ -267,7 +267,7 @@ subroutine psb_mhalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_mhalov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_mhalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_mhalov diff --git a/base/comm/psb_movrl_a.f90 b/base/comm/psb_movrl_a.f90 index 39d4d6bd..42d7d82d 100644 --- a/base/comm/psb_movrl_a.f90 +++ b/base/comm/psb_movrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_movrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_movrlm @@ -266,7 +266,7 @@ subroutine psb_movrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_movrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_movrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_movrlv diff --git a/base/comm/psb_mscatter_a.F90 b/base/comm/psb_mscatter_a.F90 index b907a015..2c6d9fbb 100644 --- a/base/comm/psb_mscatter_a.F90 +++ b/base/comm/psb_mscatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_sgather.f90 b/base/comm/psb_sgather.f90 index d1c43f29..857f5fd6 100644 --- a/base/comm/psb_sgather.f90 +++ b/base/comm/psb_sgather.f90 @@ -57,7 +57,7 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -71,10 +71,10 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -149,12 +149,12 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -175,7 +175,7 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -189,10 +189,10 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -266,12 +266,12 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_sgather_a.f90 b/base/comm/psb_sgather_a.f90 index 7774a11c..28d5f5dc 100644 --- a/base/comm/psb_sgather_a.f90 +++ b/base/comm/psb_sgather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_shalo.f90 b/base/comm/psb_shalo.f90 index 18548183..412fc75f 100644 --- a/base/comm/psb_shalo.f90 +++ b/base/comm/psb_shalo.f90 @@ -65,7 +65,7 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -81,10 +81,10 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -180,7 +180,7 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_shalo_vect @@ -220,7 +220,7 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -236,10 +236,10 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -336,7 +336,7 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_shalo_multivect diff --git a/base/comm/psb_shalo_a.f90 b/base/comm/psb_shalo_a.f90 index 63d88874..0030d5c9 100644 --- a/base/comm/psb_shalo_a.f90 +++ b/base/comm/psb_shalo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_shalom @@ -267,7 +267,7 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_shalov diff --git a/base/comm/psb_sovrl.f90 b/base/comm/psb_sovrl.f90 index c61161c0..05c5ade2 100644 --- a/base/comm/psb_sovrl.f90 +++ b/base/comm/psb_sovrl.f90 @@ -75,7 +75,7 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -91,10 +91,10 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -176,7 +176,7 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sovrl_vect @@ -225,7 +225,7 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -241,10 +241,10 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -328,7 +328,7 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sovrl_multivect diff --git a/base/comm/psb_sovrl_a.f90 b/base/comm/psb_sovrl_a.f90 index 23380de5..9944036d 100644 --- a/base/comm/psb_sovrl_a.f90 +++ b/base/comm/psb_sovrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sovrlm @@ -266,7 +266,7 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sovrlv diff --git a/base/comm/psb_sscatter.F90 b/base/comm/psb_sscatter.F90 index 56761278..f2b79e83 100644 --- a/base/comm/psb_sscatter.F90 +++ b/base/comm/psb_sscatter.F90 @@ -54,7 +54,7 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_s_base_vect_type), intent(in), optional :: mold ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -68,13 +68,13 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -93,7 +93,7 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_sscatter_a.F90 b/base/comm/psb_sscatter_a.F90 index 783d3576..08026536 100644 --- a/base/comm/psb_sscatter_a.F90 +++ b/base/comm/psb_sscatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index 9d0cc681..5678b676 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -67,7 +67,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -83,9 +83,9 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -129,7 +129,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) nzg = sum(nzbr) if (nzg <0) then info = psb_err_mpi_int_ovflw_ @@ -217,7 +217,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -250,7 +250,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -266,9 +266,9 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -310,7 +310,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -390,7 +390,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -422,7 +422,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -438,9 +438,9 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -482,7 +482,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -557,7 +557,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_zgather.f90 b/base/comm/psb_zgather.f90 index d7617334..b163094a 100644 --- a/base/comm/psb_zgather.f90 +++ b/base/comm/psb_zgather.f90 @@ -57,7 +57,7 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -71,10 +71,10 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -149,12 +149,12 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -175,7 +175,7 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, jlx, ilx, lda_locx, lda_globx, i integer(psb_lpk_) :: m, n, k, ilocx, jlocx, idx, iglobx, jglobx @@ -189,10 +189,10 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -266,12 +266,12 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_zgather_a.f90 b/base/comm/psb_zgather_a.f90 index ed5b3553..fa5f288b 100644 --- a/base/comm/psb_zgather_a.f90 +++ b/base/comm/psb_zgather_a.f90 @@ -57,7 +57,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -71,9 +71,9 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -110,7 +110,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) maxk = lock k = maxk - call psb_bcast(ictxt,k,root=iiroot) + call psb_bcast(ctxt,k,root=iiroot) ! there should be a global check on k here!!! @@ -157,12 +157,12 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) end do end do - call psb_sum(ictxt,globx(1:m,1:k),root=root) + call psb_sum(ctxt,globx(1:m,1:k),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -231,7 +231,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, root, iiroot, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, lda_locx, lda_globx, lock, globk,& & maxk, k, jlx, ilx, i, j @@ -246,10 +246,10 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -323,12 +323,12 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) end if end do - call psb_sum(ictxt,globx(1:m),root=root) + call psb_sum(ctxt,globx(1:m),root=root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_zhalo.f90 b/base/comm/psb_zhalo.f90 index 64cd9b2d..2bf1aef2 100644 --- a/base/comm/psb_zhalo.f90 +++ b/base/comm/psb_zhalo.f90 @@ -65,7 +65,7 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -81,10 +81,10 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -180,7 +180,7 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zhalo_vect @@ -220,7 +220,7 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, & & nrow, ncol, lldx, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -236,10 +236,10 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -336,7 +336,7 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zhalo_multivect diff --git a/base/comm/psb_zhalo_a.f90 b/base/comm/psb_zhalo_a.f90 index ede690d3..4855592a 100644 --- a/base/comm/psb_zhalo_a.f90 +++ b/base/comm/psb_zhalo_a.f90 @@ -65,7 +65,7 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, k, maxk, nrow, imode, i,& & liwork,data_, ldx @@ -82,10 +82,10 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zhalom @@ -267,7 +267,7 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data) character, intent(in), optional :: tran ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork,data_ integer(psb_lpk_) :: m, n, ix, ijx @@ -283,10 +283,10 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -375,7 +375,7 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zhalov diff --git a/base/comm/psb_zovrl.f90 b/base/comm/psb_zovrl.f90 index 13aed091..02a2a73d 100644 --- a/base/comm/psb_zovrl.f90 +++ b/base/comm/psb_zovrl.f90 @@ -75,7 +75,7 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -91,10 +91,10 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -176,7 +176,7 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zovrl_vect @@ -225,7 +225,7 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, k, iix, jjx, & & nrow, ncol, ldx, liwork, data_, update_, mode_ integer(psb_lpk_) :: m, n, ix, ijx @@ -241,10 +241,10 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -328,7 +328,7 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zovrl_multivect diff --git a/base/comm/psb_zovrl_a.f90 b/base/comm/psb_zovrl_a.f90 index 362f98ab..6af46069 100644 --- a/base/comm/psb_zovrl_a.f90 +++ b/base/comm/psb_zovrl_a.f90 @@ -76,7 +76,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, iix, jjx, nrow, ncol, k, maxk, update_,& & mode_, liwork, ldx @@ -93,10 +93,10 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -188,7 +188,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zovrlm @@ -266,7 +266,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) integer(psb_ipk_), intent(in), optional :: update,mode ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, iix, jjx, nrow, ncol, & & k, update_, mode_, liwork, ldx integer(psb_lpk_) :: m, n, ix, ijx @@ -282,10 +282,10 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -370,7 +370,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zovrlv diff --git a/base/comm/psb_zscatter.F90 b/base/comm/psb_zscatter.F90 index 753a468b..f8d2102b 100644 --- a/base/comm/psb_zscatter.F90 +++ b/base/comm/psb_zscatter.F90 @@ -54,7 +54,7 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold) class(psb_z_base_vect_type), intent(in), optional :: mold ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, icomm, myrank, rootrank integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -68,13 +68,13 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -93,7 +93,7 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_zscatter_a.F90 b/base/comm/psb_zscatter_a.F90 index 59a98f9b..aaa684b6 100644 --- a/base/comm/psb_zscatter_a.F90 +++ b/base/comm/psb_zscatter_a.F90 @@ -62,7 +62,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me, iroot, icomm, myrank, rootrank, iam, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & @@ -80,10 +80,10 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -108,8 +108,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) m = desc_a%get_global_rows() n = desc_a%get_global_cols() - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,me) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,me) if (iroot==-1) then lda_globx = size(globx, 1) @@ -160,7 +160,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -236,7 +236,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -307,7 +307,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx @@ -324,13 +324,13 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() ! check on blacs grid - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -349,8 +349,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) iroot = psb_root_ end if - icomm = psb_get_mpi_comm(ictxt) - myrank = psb_get_mpi_rank(ictxt,iam) + icomm = psb_get_mpi_comm(ctxt) + myrank = psb_get_mpi_rank(ctxt,iam) iglobx = 1 jglobx = 1 @@ -396,7 +396,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) locx(i)=globx(ltg(i)) end do else - rootrank = psb_get_mpi_rank(ictxt,iroot) + rootrank = psb_get_mpi_rank(ctxt,iroot) ! ! This is potentially unsafe when IPK=8 ! But then, IPK=8 is highly experimental anyway. @@ -474,7 +474,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 87745fa4..6b59caa8 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -67,7 +67,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -83,9 +83,9 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -129,7 +129,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep call psb_loc_to_glob(loc_coo%ja(1:nzl),locja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) nzg = sum(nzbr) if (nzg <0) then info = psb_err_mpi_int_ovflw_ @@ -217,7 +217,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -250,7 +250,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -266,9 +266,9 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -310,7 +310,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -390,7 +390,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return @@ -422,7 +422,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl logical :: keepnum_, keeploc_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_mpk_) :: icomm, minfo, ndx, root_ integer(psb_mpk_), allocatable :: nzbr(:), idisp(:) @@ -438,9 +438,9 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (present(keepnum)) then keepnum_ = keepnum @@ -482,7 +482,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I') nzbr(:) = 0 nzbr(me+1) = nzl - call psb_sum(ictxt,nzbr(1:np)) + call psb_sum(ctxt,nzbr(1:np)) lnzbr = nzbr nzg = sum(nzbr) if ((nzg < 0).or.(nzg /= sum(lnzbr))) then @@ -557,7 +557,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k 9999 continue call psb_errpush(info,name) - call psb_error_handler(ictxt,err_act) + call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_a2a_fnd_owner.F90 b/base/internals/psi_a2a_fnd_owner.F90 index b0912078..1e0a1ab3 100644 --- a/base/internals/psi_a2a_fnd_owner.F90 +++ b/base/internals/psi_a2a_fnd_owner.F90 @@ -77,7 +77,7 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) integer(psb_mpk_) :: icomm, minfo, nv integer(psb_ipk_) :: i,n_row,n_col,err_act,gsz integer(psb_lpk_) :: mglob, ih - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, nresp logical, parameter :: use_psi_adj=.true. real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx @@ -88,13 +88,13 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) name = 'psi_a2a_fnd_owner' call psb_erractionsave(err_act) - ictxt = idxmap%get_ctxt() + ctxt = idxmap%get_ctxt() icomm = idxmap%get_mpic() mglob = idxmap%get_gr() n_row = idxmap%get_lr() n_col = idxmap%get_lc() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ @@ -200,7 +200,7 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_adjcncy_fnd_owner.F90 b/base/internals/psi_adjcncy_fnd_owner.F90 index 40ee26dc..cc215ca9 100644 --- a/base/internals/psi_adjcncy_fnd_owner.F90 +++ b/base/internals/psi_adjcncy_fnd_owner.F90 @@ -85,7 +85,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) integer(psb_ipk_) :: i,n_row,n_col,err_act,hsize,ip,isz,j, k,& & last_ih, last_j, nidx, nrecv, nadj integer(psb_lpk_) :: mglob, ih - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: gettime=.true., debug=.false. integer(psb_mpk_) :: xchg_alg @@ -99,7 +99,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) name = 'psi_adjcncy_fnd_owner' call psb_erractionsave(err_act) - ictxt = idxmap%get_ctxt() + ctxt = idxmap%get_ctxt() icomm = idxmap%get_mpic() mglob = idxmap%get_gr() n_row = idxmap%get_lr() @@ -119,7 +119,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) & idx_phase13 = psb_get_timer_idx("ADJ_FND_OWN: phase13") - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ @@ -280,7 +280,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) do i = 0, np-1 if (rvsz(i)>0) then ! write(0,*) me, ' First receive from ',i,rvsz(i) - prc = psb_get_mpi_rank(ictxt,i) + prc = psb_get_mpi_rank(ctxt,i) p2ptag = psb_long_swap_tag !write(0,*) me, ' Posting first receive from ',i,rvsz(i),prc call mpi_irecv(rmtidx(hidx(i)+1),rvsz(i),& @@ -292,7 +292,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) if (do_timings) call psb_tic(idx_phase12) do j=1, nadj if (nidx > 0) then - prc = psb_get_mpi_rank(ictxt,adj(j)) + prc = psb_get_mpi_rank(ctxt,adj(j)) p2ptag = psb_long_swap_tag !write(0,*) me, ' First send to ',adj(j),nidx, prc call mpi_send(idx,nidx,& @@ -324,7 +324,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) do j=1, nadj !write(0,*) me, ' First send to ',adj(j),nidx if (nidx > 0) then - prc = psb_get_mpi_rank(ictxt,adj(j)) + prc = psb_get_mpi_rank(ctxt,adj(j)) p2ptag = psb_int_swap_tag !write(0,*) me, ' Posting second receive from ',adj(j),nidx, prc call mpi_irecv(lclidx((j-1)*nidx+1),nidx, & @@ -338,7 +338,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! do i = 0, np-1 if (rvsz(i)>0) then - prc = psb_get_mpi_rank(ictxt,i) + prc = psb_get_mpi_rank(ctxt,i) p2ptag = psb_int_swap_tag !write(0,*) me, ' Second send to ',i,rvsz(i), prc call mpi_send(tproc(hidx(i)+1),rvsz(i),& @@ -389,12 +389,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) end if do j=1, nadj !write(0,*) me, ' First send to ',adj(j),nidx - if (nidx > 0) call psb_snd(ictxt,idx(1:nidx),adj(j)) + if (nidx > 0) call psb_snd(ctxt,idx(1:nidx),adj(j)) end do do i = 0, np-1 if (rvsz(i)>0) then ! write(0,*) me, ' First receive from ',i,rvsz(i) - call psb_rcv(ictxt,rmtidx(hidx(i)+1:hidx(i)+rvsz(i)),i) + call psb_rcv(ctxt,rmtidx(hidx(i)+1:hidx(i)+rvsz(i)),i) end if end do @@ -413,7 +413,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) do i = 0, np-1 if (rvsz(i)>0) then !write(0,*) me, ' Second send to ',i,rvsz(i) - call psb_snd(ictxt,tproc(hidx(i)+1:hidx(i)+rvsz(i)),i) + call psb_snd(ctxt,tproc(hidx(i)+1:hidx(i)+rvsz(i)),i) end if end do ! @@ -422,7 +422,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) ! do j = 1, nadj !write(0,*) me, ' Second receive from ',adj(j), nidx - if (nidx > 0) call psb_rcv(ictxt,tproc(1:nidx),adj(j)) + if (nidx > 0) call psb_rcv(ctxt,tproc(1:nidx),adj(j)) iprc(1:nidx) = max(iprc(1:nidx), tproc(1:nidx)) end do case default @@ -434,7 +434,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_bld_glb_dep_list.F90 b/base/internals/psi_bld_glb_dep_list.F90 index 94a31039..4130a0cc 100644 --- a/base/internals/psi_bld_glb_dep_list.F90 +++ b/base/internals/psi_bld_glb_dep_list.F90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -!!$subroutine psi_i_bld_glb_dep_list(ictxt,loc_dl,length_dl,dep_list,dl_lda,info) +!!$subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,dep_list,dl_lda,info) !!$ use psi_mod, psb_protect_name => psi_i_bld_glb_dep_list !!$#ifdef MPI_MOD !!$ use mpi @@ -44,7 +44,7 @@ !!$ include 'mpif.h' !!$#endif !!$ ! ....scalar parameters... -!!$ type(psb_ctxt_type), intent(in) :: ictxt +!!$ type(psb_ctxt_type), intent(in) :: ctxt !!$ integer(psb_ipk_), intent(out) :: dl_lda !!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) !!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) @@ -70,11 +70,11 @@ !!$ !!$ info = psb_success_ !!$ -!!$ call psb_info(ictxt,me,np) +!!$ call psb_info(ctxt,me,np) !!$ !!$ !!$ dl_lda = length_dl(me) -!!$ call psb_max(ictxt, dl_lda) +!!$ call psb_max(ctxt, dl_lda) !!$ !!$ if (debug_level >= psb_debug_inner_) & !!$ & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda @@ -84,7 +84,7 @@ !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') !!$ goto 9999 !!$ end if -!!$ icomm = psb_get_mpi_comm(ictxt) +!!$ icomm = psb_get_mpi_comm(ctxt) !!$ call mpi_allgather(loc_dl,dl_lda,psb_mpi_ipk_,& !!$ & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) !!$ @@ -102,7 +102,7 @@ !!$ end do !!$ flush(0) !!$ end if -!!$ call psb_barrier(ictxt) +!!$ call psb_barrier(ctxt) !!$ end if !!$ !!$ call psb_erractionrestore(err_act) @@ -118,7 +118,7 @@ !!$ !!$end subroutine psi_i_bld_glb_dep_list -subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) +subroutine psi_i_bld_glb_csr_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) use psi_mod, psb_protect_name => psi_i_bld_glb_csr_dep_list #ifdef MPI_MOD use mpi @@ -133,7 +133,7 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i include 'mpif.h' #endif ! ....scalar parameters... - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) integer(psb_ipk_), intent(out) :: info @@ -158,7 +158,7 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i info = psb_success_ - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) myld = length_dl(me) length = sum(length_dl(0:np-1)) @@ -180,7 +180,7 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') goto 9999 end if - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_allgatherv(loc_dl,myld,psb_mpi_ipk_,& & c_dep_list,length_dl,dl_ptr,psb_mpi_ipk_,icomm,minfo) @@ -198,7 +198,7 @@ subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,i end do flush(0) end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_erractionrestore(err_act) diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index 4547d2cb..78ce69ed 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -62,7 +62,7 @@ subroutine psi_bld_tmphalo(desc,info) integer(psb_ipk_) :: i,j,np,me,lhalo,nhalo,& & n_col, err_act, key, ih, nh, idx, nk,icomm - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: n_row character(len=20) :: name,ch_err @@ -70,13 +70,13 @@ subroutine psi_bld_tmphalo(desc,info) name = 'psi_bld_tmphalo' call psb_erractionsave(err_act) - ictxt = desc%get_context() + ctxt = desc%get_context() icomm = desc%get_mpic() n_row = desc%get_local_rows() n_col = desc%get_local_cols() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -145,7 +145,7 @@ subroutine psi_bld_tmphalo(desc,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_bld_tmpovrl.f90 b/base/internals/psi_bld_tmpovrl.f90 index 68c137d2..e34b6463 100644 --- a/base/internals/psi_bld_tmpovrl.f90 +++ b/base/internals/psi_bld_tmpovrl.f90 @@ -68,7 +68,7 @@ subroutine psi_i_bld_tmpovrl(iv,desc,info) & l_ov_ix,l_ov_el, err_act, itmpov, k, glx, icomm integer(psb_ipk_) :: idx integer(psb_ipk_), allocatable :: ov_idx(:),ov_el(:,:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: n_row, debug_unit, debug_level character(len=20) :: name,ch_err @@ -77,11 +77,11 @@ subroutine psi_i_bld_tmpovrl(iv,desc,info) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() + ctxt = desc%get_context() icomm = desc%get_mpic() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -144,7 +144,7 @@ subroutine psi_i_bld_tmpovrl(iv,desc,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_compute_size.f90 b/base/internals/psi_compute_size.f90 index 699ceeac..1820cfec 100644 --- a/base/internals/psi_compute_size.f90 +++ b/base/internals/psi_compute_size.f90 @@ -48,7 +48,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info) ! ....local scalars.... integer(psb_ipk_) :: i,np,me,proc, max_index integer(psb_ipk_) :: err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt ! ...local array... integer(psb_ipk_) :: int_err(5) integer(psb_ipk_), allocatable :: counter_recv(:), counter_dl(:) @@ -63,9 +63,9 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info) debug_level = psb_get_debug_level() info = psb_success_ - ictxt = desc_data(psb_ctxt_) + ctxt = desc_data(psb_ctxt_) - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -115,7 +115,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info) enddo ! computing max global value of dl_lda - call psb_amx(ictxt, dl_lda) + call psb_amx(ctxt, dl_lda) if (debug_level>=psb_debug_inner_) then write(debug_unit,*) me,' ',trim(name),': ',dl_lda @@ -124,7 +124,7 @@ subroutine psi_compute_size(desc_data, index_in, dl_lda, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 8e8118f9..334b90f4 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -64,7 +64,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) integer(psb_ipk_), allocatable, intent(inout) :: index_out(:) ! ....local scalars... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, mode, err_act, dl_lda, ldl ! ...parameters... integer(psb_ipk_), allocatable :: length_dl(:), loc_dl(:),& @@ -83,9 +83,9 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_ctxt() + ctxt = desc_a%get_ctxt() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -112,7 +112,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) mode = 1 if (do_timings) call psb_tic(idx_phase1) - call psi_extract_loc_dl(ictxt,& + call psi_extract_loc_dl(ctxt,& & desc_a%is_bld(), desc_a%is_upd(),& & index_in, loc_dl,length_dl,info) @@ -126,7 +126,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (choose_sorting(dlmax,dlavg,np)) then if (do_timings) call psb_tic(idx_phase21) - call psi_bld_glb_dep_csr_list(ictxt,& + call psi_bld_glb_dep_csr_list(ctxt,& & loc_dl,length_dl,c_dep_list,dl_ptr,info) if (info /= 0) then write(0,*) me,trim(name),' From bld_glb_list ',info @@ -136,7 +136,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) !!$ ! ....now i can sort dependency lists. if (do_timings) call psb_toc(idx_phase21) if (do_timings) call psb_tic(idx_phase22) - call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ictxt,info) + call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ctxt,info) if (info /= 0) then write(0,*) me,trim(name),' From sort_dl ',info end if @@ -202,7 +202,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return contains diff --git a/base/internals/psi_desc_impl.f90 b/base/internals/psi_desc_impl.f90 index ce5d043e..4ba6f40a 100644 --- a/base/internals/psi_desc_impl.f90 +++ b/base/internals/psi_desc_impl.f90 @@ -74,7 +74,7 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) class(psb_i_base_vect_type), optional, intent(in) :: mold ! ....local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act,nxch,nsnd,nrcv,j,k ! ...local array... @@ -94,9 +94,9 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) debug_unit = psb_get_debug_unit() info = psb_success_ - ictxt = cdesc%get_context() + ctxt = cdesc%get_context() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -211,7 +211,7 @@ subroutine psi_i_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index d2ed083b..6dc78a79 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -121,7 +121,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& ! ....local scalars... integer(psb_ipk_) :: j,me,np,i,proc ! ...parameters... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_), parameter :: no_comm=-1 ! ...local arrays.. integer(psb_lpk_),allocatable :: sndbuf(:), rcvbuf(:) @@ -149,9 +149,9 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() + ctxt = desc%get_context() icomm = desc%get_mpic() - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -160,7 +160,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& if (debug_level >= psb_debug_inner_) then write(debug_unit,*) me,' ',trim(name),': start' - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif if ((do_timings).and.(idx_phase1==-1)) & & idx_phase1 = psb_get_timer_idx("I_DSC_IDX: phase1 ") @@ -226,7 +226,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& end if if (debug_level >= psb_debug_inner_) then write(debug_unit,*) me,' ',trim(name),': computed sizes ',iszr,iszs - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif ntot = (3*(count((sdsz>0).or.(rvsz>0)))+ iszs + iszr) + 1 @@ -243,7 +243,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& if (debug_level >= psb_debug_inner_) then write(debug_unit,*) me,' ',trim(name),': computed allocated workspace ',iszr,iszs - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif allocate(sndbuf(iszs),rcvbuf(iszr),stat=info) if(info /= psb_success_) then @@ -285,7 +285,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& if (debug_level >= psb_debug_inner_) then write(debug_unit,*) me,' ',trim(name),': prepared send buffer ' - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif ! ! now have to regenerate bsdindx @@ -316,7 +316,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& ixp = 1 do i=1, length_dl proc = dep_list(i) - prcid(ixp) = psb_get_mpi_rank(ictxt,proc) + prcid(ixp) = psb_get_mpi_rank(ctxt,proc) sz = rvsz(proc+1) if (sz > 0) then p2ptag = psb_long_tag @@ -330,7 +330,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& ixp = 1 do i=1, length_dl proc = dep_list(i) - prcid(ixp) = psb_get_mpi_rank(ictxt,proc) + prcid(ixp) = psb_get_mpi_rank(ctxt,proc) sz = sdsz(proc+1) if (sz > 0) then p2ptag = psb_long_tag @@ -344,7 +344,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& ixp = 1 do i=1, length_dl proc = dep_list(i) - prcid(ixp) = psb_get_mpi_rank(ictxt,proc) + prcid(ixp) = psb_get_mpi_rank(ctxt,proc) sz = rvsz(proc+1) if (sz > 0) then call mpi_wait(rvhd(ixp),p2pstat,iret) @@ -358,7 +358,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& sz = sdsz(proc+1) idx = bsdindx(proc+1) if (sz > 0) then - call psb_snd(ictxt,sndbuf(idx+1:idx+sz), proc) + call psb_snd(ctxt,sndbuf(idx+1:idx+sz), proc) end if end do @@ -367,7 +367,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& sz = rvsz(proc+1) idx = brvindx(proc+1) if (sz > 0) then - call psb_rcv(ictxt,rcvbuf(idx+1:idx+sz),proc) + call psb_rcv(ctxt,rcvbuf(idx+1:idx+sz),proc) end if end do @@ -407,13 +407,13 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& if (do_timings) call psb_toc(idx_phase4) if (debug_level >= psb_debug_inner_) then write(debug_unit,*) me,' ',trim(name),': done' - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_extrct_dl.F90 b/base/internals/psi_extrct_dl.F90 index 379bd99b..60cf75d1 100644 --- a/base/internals/psi_extrct_dl.F90 +++ b/base/internals/psi_extrct_dl.F90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& +subroutine psi_i_extract_dep_list(ctxt,is_bld,is_upd,desc_str,dep_list,& & length_dl,dl_lda,mode,info) ! internal routine @@ -134,7 +134,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& #endif ! ....scalar parameters... logical, intent(in) :: is_bld, is_upd - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: mode integer(psb_ipk_), intent(out) :: dl_lda integer(psb_ipk_), intent(in) :: desc_str(*) @@ -167,7 +167,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& !!$ if ((do_timings).and.(idx_phase3==-1)) & !!$ & idx_phase3 = psb_get_timer_idx("PSI_XTR_DL: phase3") - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (do_timings) call psb_tic(idx_phase1) allocate(itmp(2*np+1),length_dl(0:np),stat=info) @@ -269,9 +269,9 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& if (do_timings) call psb_tic(idx_phase2) if (dist_symm_list) then call psb_realloc(length_dl(me),itmp,info) - call psi_symm_dep_list(itmp,ictxt,info) + call psi_symm_dep_list(itmp,ctxt,info) dl_lda = max(size(itmp),1) - call psb_max(ictxt, dl_lda) + call psb_max(ctxt, dl_lda) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda @@ -283,8 +283,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& goto 9999 end if - call psb_sum(ictxt,length_dl(0:np)) - icomm = psb_get_mpi_comm(ictxt) + call psb_sum(ctxt,length_dl(0:np)) + icomm = psb_get_mpi_comm(ctxt) call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_,& & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) info = minfo @@ -299,7 +299,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& integer(psb_ipk_) :: i,j,ip,dlsym, ldu, mdl, l1, l2 dl_lda = max(length_dl(me),1) - call psb_max(ictxt, dl_lda) + call psb_max(ctxt, dl_lda) if (debug_level >= psb_debug_inner_) & & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda allocate(dep_list(dl_lda,0:np),stat=info) @@ -307,8 +307,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') goto 9999 end if - call psb_sum(ictxt,length_dl(0:np)) - icomm = psb_get_mpi_comm(ictxt) + call psb_sum(ctxt,length_dl(0:np)) + icomm = psb_get_mpi_comm(ctxt) call mpi_allgather(itmp,dl_lda,psb_mpi_ipk_,& & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) info = minfo @@ -380,7 +380,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& end do flush(0) end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if if (do_timings) call psb_toc(idx_phase2) if ((profile).and.(me==0)) then diff --git a/base/internals/psi_fnd_owner.F90 b/base/internals/psi_fnd_owner.F90 index 06fb2494..7f111a03 100644 --- a/base/internals/psi_fnd_owner.F90 +++ b/base/internals/psi_fnd_owner.F90 @@ -74,7 +74,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) integer(psb_ipk_) :: i,n_row,n_col,err_act,ih,icomm,hsize,ip,isz,k,j,& & last_ih, last_j - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: gettime=.false. real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx @@ -84,14 +84,14 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) name = 'psi_fnd_owner' call psb_erractionsave(err_act) - ictxt = desc%get_context() + ctxt = desc%get_context() icomm = desc%get_mpic() n_row = desc%get_local_rows() n_col = desc%get_local_cols() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ @@ -119,7 +119,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_graph_fnd_owner.F90 b/base/internals/psi_graph_fnd_owner.F90 index 318adcdf..e507d020 100644 --- a/base/internals/psi_graph_fnd_owner.F90 +++ b/base/internals/psi_graph_fnd_owner.F90 @@ -104,7 +104,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) & nv, n_answers, nqries, nsampl_in, locr_max, & & nqries_max, nadj, maxspace, mxnsin integer(psb_lpk_) :: mglob, ih - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, nresp integer(psb_ipk_), parameter :: nt=4 integer(psb_ipk_) :: tmpv(4) @@ -117,7 +117,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) name = 'psi_graph_fnd_owner' call psb_erractionsave(err_act) - ictxt = idxmap%get_ctxt() + ctxt = idxmap%get_ctxt() icomm = idxmap%get_mpic() mglob = idxmap%get_gr() n_row = idxmap%get_lr() @@ -131,7 +131,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) & idx_loop_neigh = psb_get_timer_idx("GRPH_FND_OWN: Loop neigh") - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ @@ -180,7 +180,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) tmpv(2) = nqries_max tmpv(3) = n_row tmpv(4) = psb_cd_get_maxspace() - call psb_max(ictxt,tmpv) + call psb_max(ctxt,tmpv) nqries_max = tmpv(2) locr_max = tmpv(3) maxspace = nt*locr_max @@ -199,7 +199,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) call idxmap%xtnd_p_adjcncy(ladj) nqries = nv - n_answers nqries_max = nqries - call psb_max(ictxt,nqries_max) + call psb_max(ctxt,nqries_max) if (trace.and.(me == 0)) write(0,*) ' After initial sweep:',nqries_max if (debugsz) write(0,*) me,' After sweep on user-defined topology',nqries_max end if @@ -263,14 +263,14 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) !!$ write(0,*) me,' After a2a ',nqries nsampl_in = min(nqries,max(1,(maxspace+max(1,nadj)-1))/(max(1,nadj))) mxnsin = nsampl_in - call psb_max(ictxt,mxnsin) + call psb_max(ctxt,mxnsin) !!$ write(0,*) me, ' mxnsin ',mxnsin if (mxnsin>0) call psi_adj_fnd_sweep(idx,iprc,ladj,idxmap,nsampl_in,n_answers) call idxmap%xtnd_p_adjcncy(ladj) nqries = nv - n_answers nqries_max = nqries - call psb_max(ictxt,nqries_max) + call psb_max(ctxt,nqries_max) if (trace.and.(me == 0)) write(0,*) ' fnd_owner_loop remaining:',nqries_max if (do_timings) call psb_toc(idx_loop_neigh) end do fnd_owner_loop @@ -278,7 +278,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -361,13 +361,13 @@ contains integer(psb_ipk_), intent(in) :: adj(:) class(psb_indx_map), intent(inout) :: idxmap ! - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: ipnt, ns_in, ns_out, n_rem, me, np, isw integer(psb_lpk_), allocatable :: tidx(:) integer(psb_ipk_), allocatable :: tsmpl(:) - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,me,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,me,np) call psb_realloc(n_samples,tidx,info) call psb_realloc(n_samples,tsmpl,info) ipnt = 1 @@ -382,7 +382,7 @@ contains !write(0,*) me,' Sweep ',isw,' answers:',ns_out n_answers = n_answers + ns_out n_rem = size(idx)-ipnt - call psb_max(ictxt,n_rem) + call psb_max(ctxt,n_rem) !write(0,*) me,' Sweep ',isw,n_rem, ipnt, n_samples if (n_rem <= 0) exit isw = isw + 1 diff --git a/base/internals/psi_indx_map_fnd_owner.F90 b/base/internals/psi_indx_map_fnd_owner.F90 index 9641903e..0ecade3d 100644 --- a/base/internals/psi_indx_map_fnd_owner.F90 +++ b/base/internals/psi_indx_map_fnd_owner.F90 @@ -77,7 +77,7 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) integer(psb_ipk_) :: i, err_act, hsize integer(psb_lpk_) :: nv integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, nresp logical, parameter :: gettime=.false. real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx @@ -87,11 +87,11 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) name = 'psb_indx_map_fnd_owner' call psb_erractionsave(err_act) - ictxt = idxmap%get_ctxt() + ctxt = idxmap%get_ctxt() icomm = idxmap%get_mpic() mglob = idxmap%get_gr() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ @@ -205,12 +205,12 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) end if if (gettime) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() t1 = t1 -t0 - tamx - tidx - call psb_amx(ictxt,tamx) - call psb_amx(ictxt,tidx) - call psb_amx(ictxt,t1) + call psb_amx(ctxt,tamx) + call psb_amx(ctxt,tidx) + call psb_amx(ctxt,t1) if (me == psb_root_) then write(psb_out_unit,'(" fnd_owner idx time : ",es10.4)') tidx write(psb_out_unit,'(" fnd_owner amx time : ",es10.4)') tamx @@ -221,7 +221,7 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 index 64306364..55cc280f 100644 --- a/base/internals/psi_sort_dl.f90 +++ b/base/internals/psi_sort_dl.f90 @@ -77,7 +77,7 @@ ! node in the dependency list for the current one * ! * !********************************************************************** -subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) +subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ctxt,info) use psi_mod, psb_protect_name => psi_i_csr_sort_dl use psb_const_mod use psb_error_mod @@ -85,7 +85,7 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) implicit none integer(psb_ipk_), intent(inout) :: c_dep_list(:), dl_ptr(0:), l_dep_list(0:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info ! Local variables integer(psb_ipk_), allocatable :: dg(:), dgp(:),& @@ -96,7 +96,7 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) integer(psb_ipk_) :: me, np info = 0 - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) nedges = size(c_dep_list) allocate(dg(0:np-1),dgp(nedges),edges(2,nedges),upd(0:np-1),& diff --git a/base/internals/psi_symm_dep_list.F90 b/base/internals/psi_symm_dep_list.F90 index fb7b8b0b..728ee832 100644 --- a/base/internals/psi_symm_dep_list.F90 +++ b/base/internals/psi_symm_dep_list.F90 @@ -37,7 +37,7 @@ ! ! Arguments: ! -subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) +subroutine psi_symm_dep_list_inrv(rvsz,adj,ctxt,info) use psb_serial_mod use psb_const_mod use psb_error_mod @@ -54,7 +54,7 @@ subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) #endif integer(psb_mpk_), intent(inout) :: rvsz(0:) integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info ! @@ -70,13 +70,13 @@ subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) name = 'psi_symm_dep_list' call psb_erractionsave(err_act) - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) goto 9999 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) nadj = size(adj) @@ -110,13 +110,13 @@ subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psi_symm_dep_list_inrv -subroutine psi_symm_dep_list_norv(adj,ictxt,info) +subroutine psi_symm_dep_list_norv(adj,ctxt,info) use psb_serial_mod use psb_const_mod use psb_error_mod @@ -132,7 +132,7 @@ subroutine psi_symm_dep_list_norv(adj,ictxt,info) include 'mpif.h' #endif integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info ! @@ -150,13 +150,13 @@ subroutine psi_symm_dep_list_norv(adj,ictxt,info) call psb_erractionsave(err_act) - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) goto 9999 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) nadj = size(adj) @@ -174,7 +174,7 @@ subroutine psi_symm_dep_list_norv(adj,ictxt,info) call mpi_alltoall(sdsz,1,psb_mpi_mpk_,& & rvsz,1,psb_mpi_mpk_,icomm,minfo) - if (minfo == 0) call psi_symm_dep_list(rvsz,adj,ictxt,info) + if (minfo == 0) call psi_symm_dep_list(rvsz,adj,ctxt,info) if ((minfo /=0).or.(info /= 0)) then call psb_errpush(psb_err_from_subroutine_,name,a_err='inner call symm_dep') goto 9999 @@ -183,7 +183,7 @@ subroutine psi_symm_dep_list_norv(adj,ictxt,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/internals/psi_xtr_loc_dl.F90 b/base/internals/psi_xtr_loc_dl.F90 index 5ae93cdb..8275add9 100644 --- a/base/internals/psi_xtr_loc_dl.F90 +++ b/base/internals/psi_xtr_loc_dl.F90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) +subroutine psi_i_xtr_loc_dl(ctxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) ! internal routine ! == = ============= @@ -123,7 +123,7 @@ subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) #endif ! ....scalar parameters... logical, intent(in) :: is_bld, is_upd - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: desc_str(:) integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:) integer(psb_ipk_), intent(out) :: info @@ -144,7 +144,7 @@ subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) debug_level = psb_get_debug_level() info = psb_success_ - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) pdl = size(desc_str) allocate(loc_dl(pdl+1),length_dl(0:np),stat=info) if (info /= psb_success_) then @@ -209,11 +209,11 @@ subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) call psb_msort_unique(loc_dl(1:pdl),ldu) pdl = ldu call psb_realloc(pdl,loc_dl,info) - call psi_symm_dep_list(loc_dl,ictxt,info) + call psi_symm_dep_list(loc_dl,ctxt,info) pdl = size(loc_dl) length_dl = 0 length_dl(me) = pdl - call psb_sum(ictxt,length_dl) + call psb_sum(ctxt,length_dl) call psb_erractionrestore(err_act) return diff --git a/base/modules/comm/psi_c_comm_a_mod.f90 b/base/modules/comm/psi_c_comm_a_mod.f90 index 05724a9d..1277efdf 100644 --- a/base/modules/comm/psi_c_comm_a_mod.f90 +++ b/base/modules/comm/psi_c_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_c_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_cswapdatav - subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_c_comm_a_mod complex(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_cswapidxm - subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_cswapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_c_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_cswaptranv - subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_ctranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_c_comm_a_mod complex(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_ctranidxm - subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_ctranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_c_comm_v_mod.f90 b/base/modules/comm/psi_c_comm_v_mod.f90 index 3a2037a2..47eb7fdf 100644 --- a/base/modules/comm/psi_c_comm_v_mod.f90 +++ b/base/modules/comm/psi_c_comm_v_mod.f90 @@ -56,10 +56,10 @@ module psi_c_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_cswapdata_multivect - subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_cswap_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -69,10 +69,10 @@ module psi_c_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_cswap_vidx_vect - subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_cswap_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -106,10 +106,10 @@ module psi_c_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_cswaptran_multivect - subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_ctran_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -119,10 +119,10 @@ module psi_c_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_ctran_vidx_vect - subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_ctran_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_d_comm_a_mod.f90 b/base/modules/comm/psi_d_comm_a_mod.f90 index c8bcc3a2..e2b0aa87 100644 --- a/base/modules/comm/psi_d_comm_a_mod.f90 +++ b/base/modules/comm/psi_d_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_d_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_dswapdatav - subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_d_comm_a_mod real(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_dswapidxm - subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_dswapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_d_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_dswaptranv - subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_dtranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_d_comm_a_mod real(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_dtranidxm - subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_dtranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_d_comm_v_mod.f90 b/base/modules/comm/psi_d_comm_v_mod.f90 index bee737af..6b7cdfd6 100644 --- a/base/modules/comm/psi_d_comm_v_mod.f90 +++ b/base/modules/comm/psi_d_comm_v_mod.f90 @@ -56,10 +56,10 @@ module psi_d_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_dswapdata_multivect - subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_dswap_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -69,10 +69,10 @@ module psi_d_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_dswap_vidx_vect - subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_dswap_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -106,10 +106,10 @@ module psi_d_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_dswaptran_multivect - subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_dtran_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -119,10 +119,10 @@ module psi_d_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_dtran_vidx_vect - subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_dtran_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_e_comm_a_mod.f90 b/base/modules/comm/psi_e_comm_a_mod.f90 index 8f268a8f..8c0d48ff 100644 --- a/base/modules/comm/psi_e_comm_a_mod.f90 +++ b/base/modules/comm/psi_e_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_e_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_eswapdatav - subroutine psi_eswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_e_comm_a_mod integer(psb_epk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_eswapidxm - subroutine psi_eswapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_eswapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_e_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_eswaptranv - subroutine psi_etranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_etranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_e_comm_a_mod integer(psb_epk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_etranidxm - subroutine psi_etranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_etranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_i2_comm_a_mod.f90 b/base/modules/comm/psi_i2_comm_a_mod.f90 index b16d1621..49f1af71 100644 --- a/base/modules/comm/psi_i2_comm_a_mod.f90 +++ b/base/modules/comm/psi_i2_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_i2_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_i2swapdatav - subroutine psi_i2swapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_i2_comm_a_mod integer(psb_i2pk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_i2swapidxm - subroutine psi_i2swapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_i2swapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_i2_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_i2swaptranv - subroutine psi_i2tranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_i2tranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_i2_comm_a_mod integer(psb_i2pk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_i2tranidxm - subroutine psi_i2tranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_i2tranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_i_comm_v_mod.f90 b/base/modules/comm/psi_i_comm_v_mod.f90 index 6e10eb80..4072a6c4 100644 --- a/base/modules/comm/psi_i_comm_v_mod.f90 +++ b/base/modules/comm/psi_i_comm_v_mod.f90 @@ -57,10 +57,10 @@ module psi_i_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_iswapdata_multivect - subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_iswap_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -70,10 +70,10 @@ module psi_i_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_iswap_vidx_vect - subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_iswap_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_i_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_iswaptran_multivect - subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_itran_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -120,10 +120,10 @@ module psi_i_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_itran_vidx_vect - subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_itran_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_l_comm_v_mod.f90 b/base/modules/comm/psi_l_comm_v_mod.f90 index 375c15de..b3b55a0d 100644 --- a/base/modules/comm/psi_l_comm_v_mod.f90 +++ b/base/modules/comm/psi_l_comm_v_mod.f90 @@ -58,10 +58,10 @@ module psi_l_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_lswapdata_multivect - subroutine psi_lswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_lswap_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -71,10 +71,10 @@ module psi_l_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_lswap_vidx_vect - subroutine psi_lswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_lswap_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -108,10 +108,10 @@ module psi_l_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_lswaptran_multivect - subroutine psi_ltran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_ltran_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -121,10 +121,10 @@ module psi_l_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_ltran_vidx_vect - subroutine psi_ltran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_ltran_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_m_comm_a_mod.f90 b/base/modules/comm/psi_m_comm_a_mod.f90 index 58ff0214..ca49efa5 100644 --- a/base/modules/comm/psi_m_comm_a_mod.f90 +++ b/base/modules/comm/psi_m_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_m_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_mswapdatav - subroutine psi_mswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_m_comm_a_mod integer(psb_mpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_mswapidxm - subroutine psi_mswapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_mswapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_m_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_mswaptranv - subroutine psi_mtranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_mtranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_m_comm_a_mod integer(psb_mpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_mtranidxm - subroutine psi_mtranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_mtranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_s_comm_a_mod.f90 b/base/modules/comm/psi_s_comm_a_mod.f90 index 8320dd9f..f2d3ae79 100644 --- a/base/modules/comm/psi_s_comm_a_mod.f90 +++ b/base/modules/comm/psi_s_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_s_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_sswapdatav - subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_s_comm_a_mod real(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_sswapidxm - subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_sswapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_s_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_sswaptranv - subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_stranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_s_comm_a_mod real(psb_spk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_stranidxm - subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_stranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_s_comm_v_mod.f90 b/base/modules/comm/psi_s_comm_v_mod.f90 index 419d6967..a2eb0bcf 100644 --- a/base/modules/comm/psi_s_comm_v_mod.f90 +++ b/base/modules/comm/psi_s_comm_v_mod.f90 @@ -56,10 +56,10 @@ module psi_s_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_sswapdata_multivect - subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_sswap_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -69,10 +69,10 @@ module psi_s_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_sswap_vidx_vect - subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_sswap_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -106,10 +106,10 @@ module psi_s_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_sswaptran_multivect - subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_stran_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -119,10 +119,10 @@ module psi_s_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_stran_vidx_vect - subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_stran_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_z_comm_a_mod.f90 b/base/modules/comm/psi_z_comm_a_mod.f90 index 109fc60c..16872677 100644 --- a/base/modules/comm/psi_z_comm_a_mod.f90 +++ b/base/modules/comm/psi_z_comm_a_mod.f90 @@ -52,10 +52,10 @@ module psi_z_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_zswapdatav - subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -63,10 +63,10 @@ module psi_z_comm_a_mod complex(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_zswapidxm - subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_zswapidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_Mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -96,10 +96,10 @@ module psi_z_comm_a_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_zswaptranv - subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,& + subroutine psi_ztranidxm(ctxt,icomm,flag,n,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag, n integer(psb_ipk_), intent(out) :: info @@ -107,10 +107,10 @@ module psi_z_comm_a_mod complex(psb_dpk_),target :: work(:) integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv end subroutine psi_ztranidxm - subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,& + subroutine psi_ztranidxv(ctxt,icomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: icomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/comm/psi_z_comm_v_mod.f90 b/base/modules/comm/psi_z_comm_v_mod.f90 index 58341880..02c1b8d8 100644 --- a/base/modules/comm/psi_z_comm_v_mod.f90 +++ b/base/modules/comm/psi_z_comm_v_mod.f90 @@ -56,10 +56,10 @@ module psi_z_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_zswapdata_multivect - subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_zswap_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -69,10 +69,10 @@ module psi_z_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_zswap_vidx_vect - subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_zswap_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -106,10 +106,10 @@ module psi_z_comm_v_mod type(psb_desc_type), target :: desc_a integer(psb_ipk_), optional :: data end subroutine psi_zswaptran_multivect - subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_ztran_vidx_vect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info @@ -119,10 +119,10 @@ module psi_z_comm_v_mod class(psb_i_base_vect_type), intent(inout) :: idx integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv end subroutine psi_ztran_vidx_vect - subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,& + subroutine psi_ztran_vidx_multivect(ctxt,iicomm,flag,beta,y,idx,& & totxch,totsnd,totrcv,work,info) import - type(psb_ctxt_type), intent(in) :: iictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: iicomm integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index 8d2c6190..cc003759 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -395,17 +395,17 @@ contains val = (m > psb_cd_get_large_threshold()) end function psb_cd_is_large_size - function psb_cd_choose_large_state(ictxt,m) result(val) + function psb_cd_choose_large_state(ctxt,m) result(val) use psb_penv_mod implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: m logical :: val !locals integer(psb_ipk_) :: np,me - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ! Since the hashed lists take up (somewhat) more than 2*N_COL integers, ! it makes no sense to use them if you don't have at least @@ -750,7 +750,7 @@ contains integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, debug_level, debug_unit logical, parameter :: debug=.false., debugprt=.false. character(len=20), parameter :: name='psb_cd_get_list' @@ -760,9 +760,9 @@ contains debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = psb_cd_get_context(desc) + ctxt = psb_cd_get_context(desc) - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) select case(data) case(psb_comm_halo_) @@ -815,7 +815,7 @@ contains integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act, debug_level, debug_unit logical, parameter :: debug=.false., debugprt=.false. character(len=20), parameter :: name='psb_cd_v_get_list' @@ -825,9 +825,9 @@ contains debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = psb_cd_get_context(desc) + ctxt = psb_cd_get_context(desc) - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) select case(data) case(psb_comm_halo_) @@ -896,7 +896,7 @@ contains class(psb_desc_type), intent(inout) :: desc integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act character(len=20) :: name @@ -996,7 +996,7 @@ contains integer(psb_ipk_), intent(out) :: info !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -1012,8 +1012,8 @@ contains ! when desc is empty. ! if (desc%is_valid()) then - ictxt = desc%get_ctxt() - call psb_info(ictxt,me,np) + ctxt = desc%get_ctxt() + call psb_info(ctxt,me,np) if (info == psb_success_) & & call psb_move_alloc( desc%halo_index , desc_out%halo_index , info) @@ -1085,7 +1085,7 @@ contains class(psb_desc_type), intent(inout) :: desc_out integer(psb_ipk_), intent(out) :: info !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -1100,10 +1100,10 @@ contains call desc_out%free(info) if ((info == psb_success_).and.desc%is_valid()) then - ictxt = desc%get_ctxt() + ctxt = desc%get_ctxt() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': Entered' if (np == -1) then @@ -1153,7 +1153,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -1171,7 +1171,7 @@ contains integer(psb_ipk_), intent(out) :: info ! .. Local Scalars .. - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: incnt, outcnt, j, np, me, l_tmp,& & idx, proc, n_elem_send, n_elem_recv integer(psb_ipk_), pointer :: idxlist(:) @@ -1184,8 +1184,8 @@ contains debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() - call psb_info(ictxt, me, np) + ctxt = desc%get_context() + call psb_info(ctxt, me, np) select case(data) case(psb_comm_halo_) @@ -1240,7 +1240,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -1258,7 +1258,7 @@ contains integer(psb_ipk_), intent(out) :: info ! .. Local Scalars .. - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: incnt, outcnt, j, np, me, l_tmp,& & idx, proc, n_elem_send, n_elem_recv integer(psb_ipk_), pointer :: idxlist(:) @@ -1272,8 +1272,8 @@ contains debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() - call psb_info(ictxt, me, np) + ctxt = desc%get_context() + call psb_info(ctxt, me, np) select case(data) case(psb_comm_halo_) @@ -1335,7 +1335,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 20dc28e4..b4f798d9 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -535,12 +535,12 @@ contains !!$ logical, intent(in), optional :: owned !!$ integer(psb_ipk_) :: i, nv, is, ip, lip !!$ integer(psb_lpk_) :: tidx -!!$ integer(psb_mpk_) :: ictxt, iam, np +!!$ integer(psb_mpk_) :: ctxt, iam, np !!$ logical :: owned_ !!$ !!$ info = 0 -!!$ ictxt = idxmap%get_ctxt() -!!$ call psb_info(ictxt,iam,np) +!!$ ctxt = idxmap%get_ctxt() +!!$ call psb_info(ctxt,iam,np) !!$ !!$ if (present(mask)) then !!$ if (size(mask) < size(idx)) then @@ -648,12 +648,12 @@ contains !!$ !!$ integer(psb_ipk_) :: i, nv, is, ip, lip, im !!$ integer(psb_lpk_) :: tidx -!!$ integer(psb_mpk_) :: ictxt, iam, np +!!$ integer(psb_mpk_) :: ctxt, iam, np !!$ logical :: owned_ !!$ !!$ info = 0 -!!$ ictxt = idxmap%get_ctxt() -!!$ call psb_info(ictxt,iam,np) +!!$ ctxt = idxmap%get_ctxt() +!!$ call psb_info(ctxt,iam,np) !!$ is = size(idxin) !!$ im = min(is,size(idxout)) !!$ @@ -806,13 +806,13 @@ contains logical, intent(in), optional :: owned integer(psb_ipk_) :: i, nv, is integer(psb_lpk_) :: tidx, ip, lip - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np logical :: owned_ info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) if (present(mask)) then if (size(mask) < size(idx)) then @@ -923,13 +923,13 @@ contains integer(psb_ipk_) :: i, nv, is, im integer(psb_lpk_) :: tidx, ip, lip - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np logical :: owned_ info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) is = size(idxin) im = min(is,size(idxout)) @@ -1940,12 +1940,12 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_gen_block_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np, nv, ip, i integer(psb_lpk_) :: tidx - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) nv = size(idx) allocate(iprc(nv),stat=info) if (info /= 0) then @@ -1961,13 +1961,13 @@ contains - subroutine block_init(idxmap,ictxt,nl,info) + subroutine block_init(idxmap,ctxt,nl,info) use psb_penv_mod use psb_realloc_mod use psb_error_mod implicit none class(psb_gen_block_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -1977,9 +1977,9 @@ contains integer(psb_lpk_), allocatable :: vnl(:) info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt' + write(psb_err_unit,*) 'Invalid ctxt' info = -1 return end if @@ -1991,7 +1991,7 @@ contains vnl(:) = 0 vnl(iam) = nl - call psb_sum(ictxt,vnl) + call psb_sum(ctxt,vnl) ntot = sum(vnl) vnl(1:np) = vnl(0:np-1) vnl(0) = 0 @@ -2006,9 +2006,9 @@ contains idxmap%global_cols = ntot idxmap%local_rows = nl idxmap%local_cols = nl - idxmap%ictxt = ictxt + idxmap%ctxt = ctxt idxmap%state = psb_desc_bld_ - idxmap%mpic = psb_get_mpi_comm(ictxt) + idxmap%mpic = psb_get_mpi_comm(ctxt) idxmap%min_glob_row = vnl(iam)+1 idxmap%max_glob_row = vnl(iam+1) call move_alloc(vnl,idxmap%vnl) @@ -2033,12 +2033,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nhal, i - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np logical :: debug=.false. info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) nhal = idxmap%local_cols-idxmap%local_rows diff --git a/base/modules/desc/psb_glist_map_mod.f90 b/base/modules/desc/psb_glist_map_mod.f90 index aa721b7d..c8ac8f99 100644 --- a/base/modules/desc/psb_glist_map_mod.f90 +++ b/base/modules/desc/psb_glist_map_mod.f90 @@ -91,12 +91,12 @@ contains - subroutine glist_initvg(idxmap,ictxt,vg,info) + subroutine glist_initvg(idxmap,ctxt,vg,info) use psb_penv_mod use psb_error_mod implicit none class(psb_glist_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -106,9 +106,9 @@ contains info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt' + write(psb_err_unit,*) 'Invalid ctxt' info = -1 return end if @@ -124,9 +124,9 @@ contains return end if - idxmap%ictxt = ictxt + idxmap%ctxt = ctxt idxmap%state = psb_desc_bld_ - idxmap%mpic = psb_get_mpi_comm(ictxt) + idxmap%mpic = psb_get_mpi_comm(ctxt) nl = 0 do i=1, n @@ -158,12 +158,12 @@ contains integer(psb_ipk_), allocatable, intent(out) :: iprc(:) class(psb_glist_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np integer(psb_lpk_) :: nv, i, ngp - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) nv = size(idx) allocate(iprc(nv),stat=info) if (info /= 0) then diff --git a/base/modules/desc/psb_hash_map_mod.f90 b/base/modules/desc/psb_hash_map_mod.f90 index 04ed6e75..6cb781eb 100644 --- a/base/modules/desc/psb_hash_map_mod.f90 +++ b/base/modules/desc/psb_hash_map_mod.f90 @@ -329,13 +329,13 @@ contains logical, intent(in), optional :: owned integer(psb_ipk_) :: i, lip, nrow, nrm, is integer(psb_lpk_) :: ncol, ip, tlip, mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np logical :: owned_ info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) if (present(mask)) then if (size(mask) < size(idx)) then @@ -542,7 +542,7 @@ contains integer(psb_ipk_) :: i, is, lip, nrow, ncol, & & err_act integer(psb_lpk_) :: mglob, ip, nxt, tlip - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np character(len=20) :: name,ch_err @@ -550,8 +550,8 @@ contains name = 'hash_g2l_ins' call psb_erractionsave(err_act) - ictxt = idxmap%get_ctxt() - call psb_info(ictxt, me, np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt, me, np) is = size(idx) @@ -766,7 +766,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -800,14 +800,14 @@ contains ! ! init from VL, with checks on input. ! - subroutine hash_init_vl(idxmap,ictxt,vl,info) + subroutine hash_init_vl(idxmap,ctxt,vl,info) use psb_penv_mod use psb_error_mod use psb_sort_mod use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -819,9 +819,9 @@ contains character(len=20), parameter :: name='hash_map_init_vl' info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt' + write(psb_err_unit,*) 'Invalid ctxt' info = -1 return end if @@ -830,8 +830,8 @@ contains m = maxval(vl(1:nl)) nrt = nl - call psb_sum(ictxt,nrt) - call psb_max(ictxt,m) + call psb_sum(ctxt,nrt) + call psb_max(ctxt,m) allocate(vlu(nl), ix(nl), stat=info) if (info /= 0) then @@ -871,16 +871,16 @@ contains call psb_msort(ix(1:nlu),vlu(1:nlu),flag=psb_sort_keep_idx_) nlu = nl - call hash_init_vlu(idxmap,ictxt,m,nlu,vlu,info) + call hash_init_vlu(idxmap,ctxt,m,nlu,vlu,info) end subroutine hash_init_vl - subroutine hash_init_vg(idxmap,ictxt,vg,info) + subroutine hash_init_vg(idxmap,ctxt,vg,info) use psb_penv_mod use psb_error_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -890,9 +890,9 @@ contains integer(psb_lpk_), allocatable :: vlu(:) info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:' + write(psb_err_unit,*) 'Invalid ctxt:' info = -1 return end if @@ -925,7 +925,7 @@ contains end do - call hash_init_vlu(idxmap,ictxt,n,nl,vlu,info) + call hash_init_vlu(idxmap,ctxt,n,nl,vlu,info) end subroutine hash_init_vg @@ -933,14 +933,14 @@ contains ! ! init from VL, with no checks on input ! - subroutine hash_init_vlu(idxmap,ictxt,ntot,nl,vlu,info) + subroutine hash_init_vlu(idxmap,ctxt,ntot,nl,vlu,info) use psb_penv_mod use psb_error_mod use psb_sort_mod use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: vlu(:), ntot integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info @@ -950,9 +950,9 @@ contains character(len=20), parameter :: name='hash_map_init_vlu' info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:' + write(psb_err_unit,*) 'Invalid ctxt:' info = -1 return end if @@ -961,9 +961,9 @@ contains idxmap%global_cols = ntot idxmap%local_rows = nl idxmap%local_cols = nl - idxmap%ictxt = ictxt + idxmap%ctxt = ctxt idxmap%state = psb_desc_bld_ - idxmap%mpic = psb_get_mpi_comm(ictxt) + idxmap%mpic = psb_get_mpi_comm(ctxt) lc2 = int(1.5*nl) call psb_realloc(lc2,idxmap%loc_to_glob,info) @@ -998,7 +998,7 @@ contains class(psb_hash_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info ! To be implemented - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np integer(psb_ipk_) :: i, j, m, nl integer(psb_ipk_) :: ih, nh, idx, nbits @@ -1006,11 +1006,11 @@ contains character(len=20), parameter :: name='hash_map_init_vlu' info = 0 - ictxt = idxmap%get_ctxt() + ctxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:' + write(psb_err_unit,*) 'Invalid ctxt:' info = -1 return end if @@ -1103,13 +1103,13 @@ contains class(psb_hash_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np integer(psb_ipk_) :: nhal info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) nhal = max(0,idxmap%local_cols-idxmap%local_rows) @@ -1538,7 +1538,7 @@ contains integer(psb_ipk_) :: err_act, nr,nc,k, nl integer(psb_lpk_) :: lk integer(psb_lpk_) :: ntot - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_ipk_), allocatable :: lidx(:), tadj(:), th_own(:) integer(psb_lpk_), allocatable :: gidx(:) @@ -1547,7 +1547,7 @@ contains info = psb_success_ call psb_get_erraction(err_act) - ictxt = idxmap%get_ctxt() + ctxt = idxmap%get_ctxt() nr = idxmap%get_lr() nc = idxmap%get_lc() ntot = idxmap%get_gr() @@ -1560,7 +1560,7 @@ contains call idxmap%get_halo_owner(th_own,info) call idxmap%free() - call hash_init_vlu(idxmap,ictxt,ntot,nr,gidx(1:nr),info) + call hash_init_vlu(idxmap,ctxt,ntot,nr,gidx(1:nr),info) if (nc>nr) then call idxmap%g2lip_ins(gidx(nr+1:nc),info,lidx=lidx(nr+1:nc)) end if diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index a8752007..d18458f0 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -108,7 +108,7 @@ module psb_indx_map_mod !> State of the map integer(psb_ipk_) :: state = psb_desc_null_ !> Communication context - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt !> MPI communicator integer(psb_mpk_) :: mpic = -1 !> Number of global rows @@ -334,21 +334,21 @@ module psb_indx_map_mod integer, parameter :: psi_symm_flag_norv_ = 0 integer, parameter :: psi_symm_flag_inrv_ = 1 interface psi_symm_dep_list - subroutine psi_symm_dep_list_inrv(rvsz,adj,ictxt,info) + subroutine psi_symm_dep_list_inrv(rvsz,adj,ctxt,info) import :: psb_indx_map, psb_ipk_, psb_lpk_, psb_mpk_, & & psb_ctxt_type implicit none integer(psb_mpk_), intent(inout) :: rvsz(0:) integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info end subroutine psi_symm_dep_list_inrv - subroutine psi_symm_dep_list_norv(adj,ictxt,info) + subroutine psi_symm_dep_list_norv(adj,ctxt,info) import :: psb_indx_map, psb_ipk_, psb_lpk_, psb_mpk_, & & psb_ctxt_type implicit none integer(psb_ipk_), allocatable, intent(inout) :: adj(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info end subroutine psi_symm_dep_list_norv end interface psi_symm_dep_list @@ -491,7 +491,7 @@ contains class(psb_indx_map), intent(in) :: idxmap type(psb_ctxt_type) :: val - val = idxmap%ictxt + val = idxmap%ctxt end function base_get_ctxt @@ -519,7 +519,7 @@ contains class(psb_indx_map), intent(inout) :: idxmap type(psb_ctxt_type), intent(in) :: val - idxmap%ictxt = val + idxmap%ctxt = val end subroutine base_set_ctxt subroutine base_set_gri(idxmap,val) @@ -1320,7 +1320,7 @@ contains ! almost nothing to be done here idxmap%state = -1 - if (allocated(idxmap%ictxt%ctxt)) deallocate(idxmap%ictxt%ctxt) + if (allocated(idxmap%ctxt%ctxt)) deallocate(idxmap%ctxt%ctxt) idxmap%mpic = -1 idxmap%global_rows = -1 idxmap%global_cols = -1 @@ -1336,7 +1336,7 @@ contains class(psb_indx_map), intent(inout) :: idxmap idxmap%state = psb_desc_null_ - if (allocated(idxmap%ictxt%ctxt)) deallocate(idxmap%ictxt%ctxt) + if (allocated(idxmap%ctxt%ctxt)) deallocate(idxmap%ctxt%ctxt) idxmap%mpic = -1 idxmap%global_rows = -1 idxmap%global_cols = -1 @@ -1345,12 +1345,12 @@ contains end subroutine base_set_null - subroutine base_init_vl(idxmap,ictxt,vl,info) + subroutine base_init_vl(idxmap,ctxt,vl,info) use psb_penv_mod use psb_error_mod implicit none class(psb_indx_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1414,7 +1414,7 @@ contains call psb_get_erraction(err_act) outmap%state = idxmap%state - outmap%ictxt = idxmap%ictxt + outmap%ctxt = idxmap%ctxt outmap%mpic = idxmap%mpic outmap%global_rows = idxmap%global_rows outmap%global_cols = idxmap%global_cols @@ -1475,7 +1475,7 @@ contains integer(psb_ipk_) :: me, np integer(psb_ipk_) :: i, j, nr, nc, nh - call psb_info(idxmap%ictxt,me,np) + call psb_info(idxmap%ctxt,me,np) ! The idea here is to store only the halo part nr = idxmap%local_rows nc = idxmap%local_cols diff --git a/base/modules/desc/psb_list_map_mod.f90 b/base/modules/desc/psb_list_map_mod.f90 index 558b4bc2..5c63aa6c 100644 --- a/base/modules/desc/psb_list_map_mod.f90 +++ b/base/modules/desc/psb_list_map_mod.f90 @@ -1039,12 +1039,12 @@ contains - subroutine list_initvl(idxmap,ictxt,vl,info) + subroutine list_initvl(idxmap,ctxt,vl,info) use psb_penv_mod use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -1053,9 +1053,9 @@ contains integer(psb_ipk_) :: iam, np info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:' + write(psb_err_unit,*) 'Invalid ctxt:' info = -1 return end if @@ -1068,17 +1068,17 @@ contains end if lvl(1:nl) = vl(1:nl) - call idxmap%init_vl(ictxt,lvl,info) + call idxmap%init_vl(ctxt,lvl,info) end subroutine list_initvl - subroutine list_initlvl(idxmap,ictxt,vl,info) + subroutine list_initlvl(idxmap,ctxt,vl,info) use psb_penv_mod use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented @@ -1086,9 +1086,9 @@ contains integer(psb_ipk_) :: iam, np info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:' + write(psb_err_unit,*) 'Invalid ctxt:' info = -1 return end if @@ -1098,8 +1098,8 @@ contains n = maxval(vl(1:nl)) nrt = nl - call psb_sum(ictxt,nrt) - call psb_max(ictxt,n) + call psb_sum(ctxt,nrt) + call psb_max(ctxt,n) if (n /= nrt) then @@ -1117,9 +1117,9 @@ contains return end if - idxmap%ictxt = ictxt + idxmap%ctxt = ctxt idxmap%state = psb_desc_bld_ - idxmap%mpic = psb_get_mpi_comm(ictxt) + idxmap%mpic = psb_get_mpi_comm(ctxt) do i=1, n idxmap%glob_to_loc(i) = -1 end do @@ -1147,12 +1147,12 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nhal - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) nhal = idxmap%local_cols call psb_realloc(nhal,idxmap%loc_to_glob,info) diff --git a/base/modules/desc/psb_repl_map_mod.f90 b/base/modules/desc/psb_repl_map_mod.f90 index 815a1431..e0d352e2 100644 --- a/base/modules/desc/psb_repl_map_mod.f90 +++ b/base/modules/desc/psb_repl_map_mod.f90 @@ -704,11 +704,11 @@ contains class(psb_repl_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nv - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) nv = size(idx) allocate(iprc(nv),stat=info) @@ -721,21 +721,21 @@ contains end subroutine repl_fnd_owner - subroutine repl_init(idxmap,ictxt,nl,info) + subroutine repl_init(idxmap,ctxt,nl,info) use psb_penv_mod use psb_error_mod implicit none class(psb_repl_map), intent(inout) :: idxmap integer(psb_lpk_), intent(in) :: nl - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info ! To be implemented integer(psb_ipk_) :: iam, np info = 0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (np < 0) then - write(psb_err_unit,*) 'Invalid ictxt:' + write(psb_err_unit,*) 'Invalid ctxt:' info = -1 return end if @@ -745,9 +745,9 @@ contains idxmap%global_cols = nl idxmap%local_rows = nl idxmap%local_cols = nl - idxmap%ictxt = ictxt + idxmap%ctxt = ctxt idxmap%state = psb_desc_bld_ - idxmap%mpic = psb_get_mpi_comm(ictxt) + idxmap%mpic = psb_get_mpi_comm(ctxt) call idxmap%set_state(psb_desc_bld_) end subroutine repl_init @@ -760,12 +760,12 @@ contains class(psb_repl_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: iam, np info = 0 - ictxt = idxmap%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = idxmap%get_ctxt() + call psb_info(ctxt,iam,np) call idxmap%set_state(psb_desc_asb_) diff --git a/base/modules/error.f90 b/base/modules/error.f90 index 4e20e708..10cb1339 100644 --- a/base/modules/error.f90 +++ b/base/modules/error.f90 @@ -33,14 +33,14 @@ ! Wrapper subroutines to provide error tools to F77 and C code ! -subroutine FCpsb_errcomm(ictxt, err) +subroutine FCpsb_errcomm(ctxt, err) use psb_const_mod use psb_error_mod use psi_penv_mod - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(inout):: err - call psb_errcomm(ictxt, err) + call psb_errcomm(ctxt, err) end subroutine FCpsb_errcomm @@ -66,15 +66,15 @@ subroutine FCpsb_serror() end subroutine FCpsb_serror -subroutine FCpsb_perror(ictxt) +subroutine FCpsb_perror(ctxt) use psb_const_mod use psb_error_mod use psi_penv_mod implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt - call psb_error(ictxt) + call psb_error(ctxt) end subroutine FCpsb_perror diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index 4f26c8a1..17113ec0 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -79,7 +79,7 @@ contains ! SUM ! - subroutine psb_csums(ictxt,dat,root) + subroutine psb_csums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -87,7 +87,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -96,14 +96,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,info) dat = dat_ @@ -114,7 +114,7 @@ contains #endif end subroutine psb_csums - subroutine psb_csumv(ictxt,dat,root) + subroutine psb_csumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -123,7 +123,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -132,14 +132,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -158,7 +158,7 @@ contains #endif end subroutine psb_csumv - subroutine psb_csumm(ictxt,dat,root) + subroutine psb_csumm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -167,7 +167,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -177,14 +177,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -207,7 +207,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_camxs(ictxt,dat,root) + subroutine psb_camxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -215,7 +215,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -224,14 +224,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camx_op,icomm,info) dat = dat_ @@ -242,7 +242,7 @@ contains #endif end subroutine psb_camxs - subroutine psb_camxv(ictxt,dat,root) + subroutine psb_camxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -251,7 +251,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -260,14 +260,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -286,7 +286,7 @@ contains #endif end subroutine psb_camxv - subroutine psb_camxm(ictxt,dat,root) + subroutine psb_camxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -295,7 +295,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -305,14 +305,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -335,7 +335,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_camns(ictxt,dat,root) + subroutine psb_camns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -343,7 +343,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -352,14 +352,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_c_spk_,mpi_camn_op,icomm,info) dat = dat_ @@ -370,7 +370,7 @@ contains #endif end subroutine psb_camns - subroutine psb_camnv(ictxt,dat,root) + subroutine psb_camnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -379,7 +379,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -388,14 +388,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -414,7 +414,7 @@ contains #endif end subroutine psb_camnv - subroutine psb_camnm(ictxt,dat,root) + subroutine psb_camnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -423,7 +423,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -433,14 +433,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -463,7 +463,7 @@ contains ! BCAST Broadcast ! - subroutine psb_cbcasts(ictxt,dat,root) + subroutine psb_cbcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -471,7 +471,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -480,20 +480,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_c_spk_,root_,icomm,info) #endif end subroutine psb_cbcasts - subroutine psb_cbcastv(ictxt,dat,root) + subroutine psb_cbcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -502,7 +502,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -510,19 +510,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info) #endif end subroutine psb_cbcastv - subroutine psb_cbcastm(ictxt,dat,root) + subroutine psb_cbcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -531,7 +531,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -541,14 +541,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_c_spk_,root_,icomm,info) #endif end subroutine psb_cbcastm @@ -559,7 +559,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_cscan_sums(ictxt,dat) + subroutine psb_cscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -567,22 +567,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_cscan_sums - subroutine psb_cexscan_sums(ictxt,dat) + subroutine psb_cexscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -590,7 +590,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -598,8 +598,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -607,7 +607,7 @@ contains #endif end subroutine psb_cexscan_sums - subroutine psb_cscan_sumv(ictxt,dat,root) + subroutine psb_cscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -616,7 +616,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -625,8 +625,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -634,7 +634,7 @@ contains #endif end subroutine psb_cscan_sumv - subroutine psb_cexscan_sumv(ictxt,dat,root) + subroutine psb_cexscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -643,7 +643,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -652,8 +652,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -664,17 +664,17 @@ contains end subroutine psb_cexscan_sumv subroutine psb_c_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_c_p2p_mod implicit none complex(psb_spk_), intent(in) :: valsnd(:) complex(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -693,14 +693,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_c_simple_a2av subroutine psb_c_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -713,7 +713,7 @@ contains complex(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -721,9 +721,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_complex_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -755,7 +755,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_complex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -783,7 +783,7 @@ contains end subroutine psb_c_m_simple_triad_a2av subroutine psb_c_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -796,7 +796,7 @@ contains complex(psb_spk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -804,9 +804,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_complex_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -838,7 +838,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_complex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_c_p2p_mod.F90 b/base/modules/penv/psi_c_p2p_mod.F90 index 2230f49a..245a98b6 100644 --- a/base/modules/penv/psi_c_p2p_mod.F90 +++ b/base/modules/penv/psi_c_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_c_p2p_mod contains - subroutine psb_csnds(ictxt,dat,dst) + subroutine psb_csnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst complex(psb_spk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_complex_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_csnds - subroutine psb_csndv(ictxt,dat,dst) + subroutine psb_csndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst complex(psb_spk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_complex_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_csndv - subroutine psb_csndm(ictxt,dat,dst,m) + subroutine psb_csndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_complex_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_complex_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_csndm - subroutine psb_crcvs(ictxt,dat,src) + subroutine psb_crcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_crcvs - subroutine psb_crcvv(ictxt,dat,src) + subroutine psb_crcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src complex(psb_spk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_crcvv - subroutine psb_crcvm(ictxt,dat,src,m) + subroutine psb_crcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_spk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_c_spk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_complex_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/penv/psi_collective_mod.F90 b/base/modules/penv/psi_collective_mod.F90 index fab751ec..2a669c53 100644 --- a/base/modules/penv/psi_collective_mod.F90 +++ b/base/modules/penv/psi_collective_mod.F90 @@ -52,7 +52,7 @@ module psi_collective_mod contains - subroutine psb_hbcasts(ictxt,dat,root,length) + subroutine psb_hbcasts(ctxt,dat,root,length) #ifdef MPI_MOD use mpi #endif @@ -60,7 +60,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt character(len=*), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root,length @@ -78,14 +78,14 @@ contains length_ = len(dat) endif - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,length_,MPI_CHARACTER,root_,icomm,info) #endif end subroutine psb_hbcasts - subroutine psb_hbcastv(ictxt,dat,root) + subroutine psb_hbcastv(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -93,7 +93,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt character(len=*), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root @@ -109,14 +109,14 @@ contains length_ = len(dat) size_ = size(dat) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,length_*size_,MPI_CHARACTER,root_,icomm,info) #endif end subroutine psb_hbcastv - subroutine psb_lbcasts(ictxt,dat,root) + subroutine psb_lbcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -124,7 +124,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root @@ -137,14 +137,14 @@ contains root_ = psb_root_ endif - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,MPI_LOGICAL,root_,icomm,info) #endif end subroutine psb_lbcasts - subroutine psb_lallreduceand(ictxt,dat,rec) + subroutine psb_lallreduceand(ctxt,dat,rec) #ifdef MPI_MOD use mpi #endif @@ -152,15 +152,15 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(inout) :: dat logical, intent(inout), optional :: rec integer(psb_mpk_) :: iam, np, info, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) if (present(rec)) then call mpi_allreduce(dat,rec,1,MPI_LOGICAL,MPI_LAND,icomm,info) else @@ -171,7 +171,7 @@ contains end subroutine psb_lallreduceand - subroutine psb_lbcastv(ictxt,dat,root) + subroutine psb_lbcastv(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -179,7 +179,7 @@ end subroutine psb_lallreduceand #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root @@ -191,15 +191,15 @@ end subroutine psb_lallreduceand else root_ = psb_root_ endif - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),MPI_LOGICAL,root_,icomm,info) #endif end subroutine psb_lbcastv #if defined(SHORT_INTEGERS) - subroutine psb_i2sums(ictxt,dat,root) + subroutine psb_i2sums(ctxt,dat,root) #ifdef MPI_MOD use mpi @@ -208,7 +208,7 @@ end subroutine psb_lallreduceand #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -218,14 +218,14 @@ end subroutine psb_lallreduceand #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,info) dat = dat_ @@ -237,7 +237,7 @@ end subroutine psb_lallreduceand #endif end subroutine psb_i2sums - subroutine psb_i2sumv(ictxt,dat,root) + subroutine psb_i2sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -246,7 +246,7 @@ end subroutine psb_lallreduceand #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -256,14 +256,14 @@ end subroutine psb_lallreduceand #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_=dat @@ -281,7 +281,7 @@ end subroutine psb_lallreduceand #endif end subroutine psb_i2sumv - subroutine psb_i2summ(ictxt,dat,root) + subroutine psb_i2summ(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -290,7 +290,7 @@ end subroutine psb_lallreduceand #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_mpk_), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -300,14 +300,14 @@ end subroutine psb_lallreduceand #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_=dat diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index 05ca9a24..eabe5b3f 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -91,7 +91,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_dmaxs(ictxt,dat,root) + subroutine psb_dmaxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -99,7 +99,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -109,14 +109,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_max,icomm,info) dat = dat_ @@ -127,7 +127,7 @@ contains #endif end subroutine psb_dmaxs - subroutine psb_dmaxv(ictxt,dat,root) + subroutine psb_dmaxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -136,7 +136,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -146,14 +146,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -172,7 +172,7 @@ contains #endif end subroutine psb_dmaxv - subroutine psb_dmaxm(ictxt,dat,root) + subroutine psb_dmaxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -191,14 +191,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -222,7 +222,7 @@ contains ! - subroutine psb_dmins(ictxt,dat,root) + subroutine psb_dmins(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -230,7 +230,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -240,14 +240,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_min,icomm,info) dat = dat_ @@ -258,7 +258,7 @@ contains #endif end subroutine psb_dmins - subroutine psb_dminv(ictxt,dat,root) + subroutine psb_dminv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -267,7 +267,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -277,14 +277,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -303,7 +303,7 @@ contains #endif end subroutine psb_dminv - subroutine psb_dminm(ictxt,dat,root) + subroutine psb_dminm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -312,7 +312,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -322,14 +322,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -354,7 +354,7 @@ contains ! Norm 2, only for reals ! ! !!!!!!!!!!!! - subroutine psb_d_nrm2s(ictxt,dat,root) + subroutine psb_d_nrm2s(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -362,7 +362,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -372,14 +372,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_dnrm2_op,icomm,info) dat = dat_ @@ -390,7 +390,7 @@ contains #endif end subroutine psb_d_nrm2s - subroutine psb_d_nrm2v(ictxt,dat,root) + subroutine psb_d_nrm2v(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -399,7 +399,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -409,14 +409,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -443,7 +443,7 @@ contains ! SUM ! - subroutine psb_dsums(ictxt,dat,root) + subroutine psb_dsums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -451,7 +451,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -460,14 +460,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,info) dat = dat_ @@ -478,7 +478,7 @@ contains #endif end subroutine psb_dsums - subroutine psb_dsumv(ictxt,dat,root) + subroutine psb_dsumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -487,7 +487,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -496,14 +496,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -522,7 +522,7 @@ contains #endif end subroutine psb_dsumv - subroutine psb_dsumm(ictxt,dat,root) + subroutine psb_dsumm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -531,7 +531,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -541,14 +541,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -571,7 +571,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_damxs(ictxt,dat,root) + subroutine psb_damxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -579,7 +579,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -588,14 +588,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damx_op,icomm,info) dat = dat_ @@ -606,7 +606,7 @@ contains #endif end subroutine psb_damxs - subroutine psb_damxv(ictxt,dat,root) + subroutine psb_damxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -615,7 +615,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -624,14 +624,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -650,7 +650,7 @@ contains #endif end subroutine psb_damxv - subroutine psb_damxm(ictxt,dat,root) + subroutine psb_damxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -659,7 +659,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -669,14 +669,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -699,7 +699,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_damns(ictxt,dat,root) + subroutine psb_damns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -707,7 +707,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -716,14 +716,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_dpk_,mpi_damn_op,icomm,info) dat = dat_ @@ -734,7 +734,7 @@ contains #endif end subroutine psb_damns - subroutine psb_damnv(ictxt,dat,root) + subroutine psb_damnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -743,7 +743,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -752,14 +752,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -778,7 +778,7 @@ contains #endif end subroutine psb_damnv - subroutine psb_damnm(ictxt,dat,root) + subroutine psb_damnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -787,7 +787,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -797,14 +797,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -827,7 +827,7 @@ contains ! BCAST Broadcast ! - subroutine psb_dbcasts(ictxt,dat,root) + subroutine psb_dbcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -835,7 +835,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -844,20 +844,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_r_dpk_,root_,icomm,info) #endif end subroutine psb_dbcasts - subroutine psb_dbcastv(ictxt,dat,root) + subroutine psb_dbcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -866,7 +866,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -874,19 +874,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,icomm,info) #endif end subroutine psb_dbcastv - subroutine psb_dbcastm(ictxt,dat,root) + subroutine psb_dbcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -895,7 +895,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -905,14 +905,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_r_dpk_,root_,icomm,info) #endif end subroutine psb_dbcastm @@ -923,7 +923,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_dscan_sums(ictxt,dat) + subroutine psb_dscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -931,22 +931,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_dscan_sums - subroutine psb_dexscan_sums(ictxt,dat) + subroutine psb_dexscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -954,7 +954,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -962,8 +962,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -971,7 +971,7 @@ contains #endif end subroutine psb_dexscan_sums - subroutine psb_dscan_sumv(ictxt,dat,root) + subroutine psb_dscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -980,7 +980,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -989,8 +989,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -998,7 +998,7 @@ contains #endif end subroutine psb_dscan_sumv - subroutine psb_dexscan_sumv(ictxt,dat,root) + subroutine psb_dexscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -1007,7 +1007,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1016,8 +1016,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -1028,17 +1028,17 @@ contains end subroutine psb_dexscan_sumv subroutine psb_d_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_d_p2p_mod implicit none real(psb_dpk_), intent(in) :: valsnd(:) real(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -1057,14 +1057,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_d_simple_a2av subroutine psb_d_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1077,7 +1077,7 @@ contains real(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1085,9 +1085,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_double_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1119,7 +1119,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_double_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -1147,7 +1147,7 @@ contains end subroutine psb_d_m_simple_triad_a2av subroutine psb_d_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1160,7 +1160,7 @@ contains real(psb_dpk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1168,9 +1168,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_double_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1202,7 +1202,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_double_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_d_p2p_mod.F90 b/base/modules/penv/psi_d_p2p_mod.F90 index 54b4e764..614c6802 100644 --- a/base/modules/penv/psi_d_p2p_mod.F90 +++ b/base/modules/penv/psi_d_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_d_p2p_mod contains - subroutine psb_dsnds(ictxt,dat,dst) + subroutine psb_dsnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst real(psb_dpk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_double_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_dsnds - subroutine psb_dsndv(ictxt,dat,dst) + subroutine psb_dsndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst real(psb_dpk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_double_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_dsndv - subroutine psb_dsndm(ictxt,dat,dst,m) + subroutine psb_dsndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_double_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_double_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_dsndm - subroutine psb_drcvs(ictxt,dat,src) + subroutine psb_drcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_drcvs - subroutine psb_drcvv(ictxt,dat,src) + subroutine psb_drcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src real(psb_dpk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_drcvv - subroutine psb_drcvm(ictxt,dat,src,m) + subroutine psb_drcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_dpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_r_dpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_double_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index c07b6e79..54d85347 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -88,7 +88,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_emaxs(ictxt,dat,root) + subroutine psb_emaxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -96,7 +96,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -106,14 +106,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_max,icomm,info) dat = dat_ @@ -124,7 +124,7 @@ contains #endif end subroutine psb_emaxs - subroutine psb_emaxv(ictxt,dat,root) + subroutine psb_emaxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -133,7 +133,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -143,14 +143,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -169,7 +169,7 @@ contains #endif end subroutine psb_emaxv - subroutine psb_emaxm(ictxt,dat,root) + subroutine psb_emaxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -178,7 +178,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -188,14 +188,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -219,7 +219,7 @@ contains ! - subroutine psb_emins(ictxt,dat,root) + subroutine psb_emins(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -227,7 +227,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -237,14 +237,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_min,icomm,info) dat = dat_ @@ -255,7 +255,7 @@ contains #endif end subroutine psb_emins - subroutine psb_eminv(ictxt,dat,root) + subroutine psb_eminv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -264,7 +264,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -274,14 +274,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -300,7 +300,7 @@ contains #endif end subroutine psb_eminv - subroutine psb_eminm(ictxt,dat,root) + subroutine psb_eminm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -309,7 +309,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -319,14 +319,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -351,7 +351,7 @@ contains ! SUM ! - subroutine psb_esums(ictxt,dat,root) + subroutine psb_esums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -359,7 +359,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -368,14 +368,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,info) dat = dat_ @@ -386,7 +386,7 @@ contains #endif end subroutine psb_esums - subroutine psb_esumv(ictxt,dat,root) + subroutine psb_esumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -395,7 +395,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -404,14 +404,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -430,7 +430,7 @@ contains #endif end subroutine psb_esumv - subroutine psb_esumm(ictxt,dat,root) + subroutine psb_esumm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -439,7 +439,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -449,14 +449,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -479,7 +479,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_eamxs(ictxt,dat,root) + subroutine psb_eamxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -487,7 +487,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -496,14 +496,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamx_op,icomm,info) dat = dat_ @@ -514,7 +514,7 @@ contains #endif end subroutine psb_eamxs - subroutine psb_eamxv(ictxt,dat,root) + subroutine psb_eamxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -523,7 +523,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -532,14 +532,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -558,7 +558,7 @@ contains #endif end subroutine psb_eamxv - subroutine psb_eamxm(ictxt,dat,root) + subroutine psb_eamxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -567,7 +567,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -577,14 +577,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -607,7 +607,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_eamns(ictxt,dat,root) + subroutine psb_eamns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -615,7 +615,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -624,14 +624,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_epk_,mpi_eamn_op,icomm,info) dat = dat_ @@ -642,7 +642,7 @@ contains #endif end subroutine psb_eamns - subroutine psb_eamnv(ictxt,dat,root) + subroutine psb_eamnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -651,7 +651,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -660,14 +660,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -686,7 +686,7 @@ contains #endif end subroutine psb_eamnv - subroutine psb_eamnm(ictxt,dat,root) + subroutine psb_eamnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -695,7 +695,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -705,14 +705,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -735,7 +735,7 @@ contains ! BCAST Broadcast ! - subroutine psb_ebcasts(ictxt,dat,root) + subroutine psb_ebcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -743,7 +743,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -752,20 +752,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_epk_,root_,icomm,info) #endif end subroutine psb_ebcasts - subroutine psb_ebcastv(ictxt,dat,root) + subroutine psb_ebcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -774,7 +774,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -782,19 +782,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_epk_,root_,icomm,info) #endif end subroutine psb_ebcastv - subroutine psb_ebcastm(ictxt,dat,root) + subroutine psb_ebcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -803,7 +803,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -813,14 +813,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_epk_,root_,icomm,info) #endif end subroutine psb_ebcastm @@ -831,7 +831,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_escan_sums(ictxt,dat) + subroutine psb_escan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -839,22 +839,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_escan_sums - subroutine psb_eexscan_sums(ictxt,dat) + subroutine psb_eexscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -862,7 +862,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -870,8 +870,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -879,7 +879,7 @@ contains #endif end subroutine psb_eexscan_sums - subroutine psb_escan_sumv(ictxt,dat,root) + subroutine psb_escan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -888,7 +888,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -897,8 +897,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -906,7 +906,7 @@ contains #endif end subroutine psb_escan_sumv - subroutine psb_eexscan_sumv(ictxt,dat,root) + subroutine psb_eexscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -915,7 +915,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -924,8 +924,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -936,17 +936,17 @@ contains end subroutine psb_eexscan_sumv subroutine psb_e_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_e_p2p_mod implicit none integer(psb_epk_), intent(in) :: valsnd(:) integer(psb_epk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -965,14 +965,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_e_simple_a2av subroutine psb_e_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -985,7 +985,7 @@ contains integer(psb_epk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -993,9 +993,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int8_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1027,7 +1027,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int8_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -1055,7 +1055,7 @@ contains end subroutine psb_e_m_simple_triad_a2av subroutine psb_e_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1068,7 +1068,7 @@ contains integer(psb_epk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1076,9 +1076,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int8_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1110,7 +1110,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int8_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_e_p2p_mod.F90 b/base/modules/penv/psi_e_p2p_mod.F90 index 239eb283..7c54bbf9 100644 --- a/base/modules/penv/psi_e_p2p_mod.F90 +++ b/base/modules/penv/psi_e_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_e_p2p_mod contains - subroutine psb_esnds(ictxt,dat,dst) + subroutine psb_esnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst integer(psb_epk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int8_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_esnds - subroutine psb_esndv(ictxt,dat,dst) + subroutine psb_esndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst integer(psb_epk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int8_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_esndv - subroutine psb_esndm(ictxt,dat,dst,m) + subroutine psb_esndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_int8_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int8_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_esndm - subroutine psb_ercvs(ictxt,dat,src) + subroutine psb_ercvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_epk_,src,psb_int8_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_ercvs - subroutine psb_ercvv(ictxt,dat,src) + subroutine psb_ercvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_epk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_ercvv - subroutine psb_ercvm(ictxt,dat,src,m) + subroutine psb_ercvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_epk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_int8_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 5a70af58..64a49ae3 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -88,7 +88,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_i2maxs(ictxt,dat,root) + subroutine psb_i2maxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -96,7 +96,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -106,14 +106,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_max,icomm,info) dat = dat_ @@ -124,7 +124,7 @@ contains #endif end subroutine psb_i2maxs - subroutine psb_i2maxv(ictxt,dat,root) + subroutine psb_i2maxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -133,7 +133,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -143,14 +143,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -169,7 +169,7 @@ contains #endif end subroutine psb_i2maxv - subroutine psb_i2maxm(ictxt,dat,root) + subroutine psb_i2maxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -178,7 +178,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -188,14 +188,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -219,7 +219,7 @@ contains ! - subroutine psb_i2mins(ictxt,dat,root) + subroutine psb_i2mins(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -227,7 +227,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -237,14 +237,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_min,icomm,info) dat = dat_ @@ -255,7 +255,7 @@ contains #endif end subroutine psb_i2mins - subroutine psb_i2minv(ictxt,dat,root) + subroutine psb_i2minv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -264,7 +264,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -274,14 +274,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -300,7 +300,7 @@ contains #endif end subroutine psb_i2minv - subroutine psb_i2minm(ictxt,dat,root) + subroutine psb_i2minm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -309,7 +309,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -319,14 +319,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -351,7 +351,7 @@ contains ! SUM ! - subroutine psb_i2sums(ictxt,dat,root) + subroutine psb_i2sums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -359,7 +359,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -368,14 +368,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,info) dat = dat_ @@ -386,7 +386,7 @@ contains #endif end subroutine psb_i2sums - subroutine psb_i2sumv(ictxt,dat,root) + subroutine psb_i2sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -395,7 +395,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -404,14 +404,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -430,7 +430,7 @@ contains #endif end subroutine psb_i2sumv - subroutine psb_i2summ(ictxt,dat,root) + subroutine psb_i2summ(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -439,7 +439,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -449,14 +449,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -479,7 +479,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_i2amxs(ictxt,dat,root) + subroutine psb_i2amxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -487,7 +487,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -496,14 +496,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amx_op,icomm,info) dat = dat_ @@ -514,7 +514,7 @@ contains #endif end subroutine psb_i2amxs - subroutine psb_i2amxv(ictxt,dat,root) + subroutine psb_i2amxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -523,7 +523,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -532,14 +532,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -558,7 +558,7 @@ contains #endif end subroutine psb_i2amxv - subroutine psb_i2amxm(ictxt,dat,root) + subroutine psb_i2amxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -567,7 +567,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -577,14 +577,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -607,7 +607,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_i2amns(ictxt,dat,root) + subroutine psb_i2amns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -615,7 +615,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -624,14 +624,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_i2pk_,mpi_i2amn_op,icomm,info) dat = dat_ @@ -642,7 +642,7 @@ contains #endif end subroutine psb_i2amns - subroutine psb_i2amnv(ictxt,dat,root) + subroutine psb_i2amnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -651,7 +651,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -660,14 +660,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -686,7 +686,7 @@ contains #endif end subroutine psb_i2amnv - subroutine psb_i2amnm(ictxt,dat,root) + subroutine psb_i2amnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -695,7 +695,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -705,14 +705,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -735,7 +735,7 @@ contains ! BCAST Broadcast ! - subroutine psb_i2bcasts(ictxt,dat,root) + subroutine psb_i2bcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -743,7 +743,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -752,20 +752,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_i2pk_,root_,icomm,info) #endif end subroutine psb_i2bcasts - subroutine psb_i2bcastv(ictxt,dat,root) + subroutine psb_i2bcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -774,7 +774,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -782,19 +782,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,icomm,info) #endif end subroutine psb_i2bcastv - subroutine psb_i2bcastm(ictxt,dat,root) + subroutine psb_i2bcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -803,7 +803,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -813,14 +813,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_i2pk_,root_,icomm,info) #endif end subroutine psb_i2bcastm @@ -831,7 +831,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_i2scan_sums(ictxt,dat) + subroutine psb_i2scan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -839,22 +839,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_i2pk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_i2scan_sums - subroutine psb_i2exscan_sums(ictxt,dat) + subroutine psb_i2exscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -862,7 +862,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat integer(psb_i2pk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -870,8 +870,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_i2pk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -879,7 +879,7 @@ contains #endif end subroutine psb_i2exscan_sums - subroutine psb_i2scan_sumv(ictxt,dat,root) + subroutine psb_i2scan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -888,7 +888,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -897,8 +897,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -906,7 +906,7 @@ contains #endif end subroutine psb_i2scan_sumv - subroutine psb_i2exscan_sumv(ictxt,dat,root) + subroutine psb_i2exscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -915,7 +915,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -924,8 +924,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -936,17 +936,17 @@ contains end subroutine psb_i2exscan_sumv subroutine psb_i2_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_i2_p2p_mod implicit none integer(psb_i2pk_), intent(in) :: valsnd(:) integer(psb_i2pk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -965,14 +965,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_i2_simple_a2av subroutine psb_i2_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -985,7 +985,7 @@ contains integer(psb_i2pk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -993,9 +993,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int2_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1027,7 +1027,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int2_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -1055,7 +1055,7 @@ contains end subroutine psb_i2_m_simple_triad_a2av subroutine psb_i2_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1068,7 +1068,7 @@ contains integer(psb_i2pk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1076,9 +1076,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int2_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1110,7 +1110,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int2_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_i2_p2p_mod.F90 b/base/modules/penv/psi_i2_p2p_mod.F90 index f24dc464..ad80cb44 100644 --- a/base/modules/penv/psi_i2_p2p_mod.F90 +++ b/base/modules/penv/psi_i2_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_i2_p2p_mod contains - subroutine psb_i2snds(ictxt,dat,dst) + subroutine psb_i2snds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst integer(psb_i2pk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int2_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_i2snds - subroutine psb_i2sndv(ictxt,dat,dst) + subroutine psb_i2sndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst integer(psb_i2pk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int2_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_i2sndv - subroutine psb_i2sndm(ictxt,dat,dst,m) + subroutine psb_i2sndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int2_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_i2sndm - subroutine psb_i2rcvs(ictxt,dat,src) + subroutine psb_i2rcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_i2rcvs - subroutine psb_i2rcvv(ictxt,dat,src) + subroutine psb_i2rcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_i2pk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_i2rcvv - subroutine psb_i2rcvm(ictxt,dat,src,m) + subroutine psb_i2rcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_i2pk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_i2pk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_int2_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index 867f997e..462a7221 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -88,7 +88,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_mmaxs(ictxt,dat,root) + subroutine psb_mmaxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -96,7 +96,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -106,14 +106,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_max,icomm,info) dat = dat_ @@ -124,7 +124,7 @@ contains #endif end subroutine psb_mmaxs - subroutine psb_mmaxv(ictxt,dat,root) + subroutine psb_mmaxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -133,7 +133,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -143,14 +143,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -169,7 +169,7 @@ contains #endif end subroutine psb_mmaxv - subroutine psb_mmaxm(ictxt,dat,root) + subroutine psb_mmaxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -178,7 +178,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -188,14 +188,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -219,7 +219,7 @@ contains ! - subroutine psb_mmins(ictxt,dat,root) + subroutine psb_mmins(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -227,7 +227,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -237,14 +237,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_min,icomm,info) dat = dat_ @@ -255,7 +255,7 @@ contains #endif end subroutine psb_mmins - subroutine psb_mminv(ictxt,dat,root) + subroutine psb_mminv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -264,7 +264,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -274,14 +274,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -300,7 +300,7 @@ contains #endif end subroutine psb_mminv - subroutine psb_mminm(ictxt,dat,root) + subroutine psb_mminm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -309,7 +309,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -319,14 +319,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -351,7 +351,7 @@ contains ! SUM ! - subroutine psb_msums(ictxt,dat,root) + subroutine psb_msums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -359,7 +359,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -368,14 +368,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,info) dat = dat_ @@ -386,7 +386,7 @@ contains #endif end subroutine psb_msums - subroutine psb_msumv(ictxt,dat,root) + subroutine psb_msumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -395,7 +395,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -404,14 +404,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -430,7 +430,7 @@ contains #endif end subroutine psb_msumv - subroutine psb_msumm(ictxt,dat,root) + subroutine psb_msumm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -439,7 +439,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -449,14 +449,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -479,7 +479,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_mamxs(ictxt,dat,root) + subroutine psb_mamxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -487,7 +487,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -496,14 +496,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamx_op,icomm,info) dat = dat_ @@ -514,7 +514,7 @@ contains #endif end subroutine psb_mamxs - subroutine psb_mamxv(ictxt,dat,root) + subroutine psb_mamxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -523,7 +523,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -532,14 +532,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -558,7 +558,7 @@ contains #endif end subroutine psb_mamxv - subroutine psb_mamxm(ictxt,dat,root) + subroutine psb_mamxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -567,7 +567,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -577,14 +577,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -607,7 +607,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_mamns(ictxt,dat,root) + subroutine psb_mamns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -615,7 +615,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -624,14 +624,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_mpk_,mpi_mamn_op,icomm,info) dat = dat_ @@ -642,7 +642,7 @@ contains #endif end subroutine psb_mamns - subroutine psb_mamnv(ictxt,dat,root) + subroutine psb_mamnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -651,7 +651,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -660,14 +660,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -686,7 +686,7 @@ contains #endif end subroutine psb_mamnv - subroutine psb_mamnm(ictxt,dat,root) + subroutine psb_mamnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -695,7 +695,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -705,14 +705,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -735,7 +735,7 @@ contains ! BCAST Broadcast ! - subroutine psb_mbcasts(ictxt,dat,root) + subroutine psb_mbcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -743,7 +743,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -752,20 +752,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_mpk_,root_,icomm,info) #endif end subroutine psb_mbcasts - subroutine psb_mbcastv(ictxt,dat,root) + subroutine psb_mbcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -774,7 +774,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -782,19 +782,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_mpk_,root_,icomm,info) #endif end subroutine psb_mbcastv - subroutine psb_mbcastm(ictxt,dat,root) + subroutine psb_mbcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -803,7 +803,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -813,14 +813,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_mpk_,root_,icomm,info) #endif end subroutine psb_mbcastm @@ -831,7 +831,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_mscan_sums(ictxt,dat) + subroutine psb_mscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -839,22 +839,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_mscan_sums - subroutine psb_mexscan_sums(ictxt,dat) + subroutine psb_mexscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -862,7 +862,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -870,8 +870,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -879,7 +879,7 @@ contains #endif end subroutine psb_mexscan_sums - subroutine psb_mscan_sumv(ictxt,dat,root) + subroutine psb_mscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -888,7 +888,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -897,8 +897,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -906,7 +906,7 @@ contains #endif end subroutine psb_mscan_sumv - subroutine psb_mexscan_sumv(ictxt,dat,root) + subroutine psb_mexscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -915,7 +915,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -924,8 +924,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -936,17 +936,17 @@ contains end subroutine psb_mexscan_sumv subroutine psb_m_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_m_p2p_mod implicit none integer(psb_mpk_), intent(in) :: valsnd(:) integer(psb_mpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -965,14 +965,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_m_simple_a2av subroutine psb_m_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -985,7 +985,7 @@ contains integer(psb_mpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -993,9 +993,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int4_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1027,7 +1027,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int4_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -1055,7 +1055,7 @@ contains end subroutine psb_m_m_simple_triad_a2av subroutine psb_m_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1068,7 +1068,7 @@ contains integer(psb_mpk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1076,9 +1076,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int4_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1110,7 +1110,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int4_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_m_p2p_mod.F90 b/base/modules/penv/psi_m_p2p_mod.F90 index 8f6801b4..9f6c7bc6 100644 --- a/base/modules/penv/psi_m_p2p_mod.F90 +++ b/base/modules/penv/psi_m_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_m_p2p_mod contains - subroutine psb_msnds(ictxt,dat,dst) + subroutine psb_msnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int4_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_msnds - subroutine psb_msndv(ictxt,dat,dst) + subroutine psb_msndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst integer(psb_mpk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int4_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_msndv - subroutine psb_msndm(ictxt,dat,dst,m) + subroutine psb_msndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_int4_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_int4_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_msndm - subroutine psb_mrcvs(ictxt,dat,src) + subroutine psb_mrcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_mrcvs - subroutine psb_mrcvv(ictxt,dat,src) + subroutine psb_mrcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_mpk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_mrcvv - subroutine psb_mrcvm(ictxt,dat,src,m) + subroutine psb_mrcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_mpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_int4_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/penv/psi_p2p_mod.F90 b/base/modules/penv/psi_p2p_mod.F90 index 0b00cbb6..84438f96 100644 --- a/base/modules/penv/psi_p2p_mod.F90 +++ b/base/modules/penv/psi_p2p_mod.F90 @@ -65,7 +65,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_lsnds(ictxt,dat,dst) + subroutine psb_lsnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -73,7 +73,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(in) :: dat integer(psb_mpk_), intent(in) :: dst logical, allocatable :: dat_(:) @@ -83,11 +83,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_logical_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_lsnds - subroutine psb_lsndv(ictxt,dat,dst) + subroutine psb_lsndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -96,7 +96,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst logical, allocatable :: dat_(:) @@ -106,12 +106,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_logical_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_lsndv - subroutine psb_lsndm(ictxt,dat,dst,m) + subroutine psb_lsndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -120,7 +120,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -144,11 +144,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_logical_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_logical_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_lsndm - subroutine psb_hsnds(ictxt,dat,dst) + subroutine psb_hsnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt character(len=*), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst character(len=1), allocatable :: dat_(:) @@ -170,7 +170,7 @@ contains do i=1, l dat_(i) = dat(i:i) end do - call psi_snd(ictxt,psb_char_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_char_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_hsnds @@ -180,7 +180,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_lrcvs(ictxt,dat,src) + subroutine psb_lrcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -189,7 +189,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -197,13 +197,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,mpi_logical,src,psb_logical_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_lrcvs - subroutine psb_lrcvv(ictxt,dat,src) + subroutine psb_lrcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -212,20 +212,20 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,ictxt,status,info) + call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,ctxt,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_lrcvv - subroutine psb_lrcvm(ictxt,dat,src,m) + subroutine psb_lrcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -234,7 +234,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -244,7 +244,7 @@ contains #if defined(SERIAL_MPI) ! What should we do here?? #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (present(m)) then m_ = m ld = size(dat,1) @@ -266,7 +266,7 @@ contains end subroutine psb_lrcvm - subroutine psb_hrcvs(ictxt,dat,src) + subroutine psb_hrcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -275,7 +275,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt character(len=*), intent(out) :: dat integer(psb_mpk_), intent(in) :: src character(len=1), allocatable :: dat_(:) @@ -285,7 +285,7 @@ contains ! do nothing #else l = len(dat) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) allocate(dat_(l), stat=info) call mpi_recv(dat_,l,mpi_character,src,psb_char_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index e51a61d8..55dde0bb 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -779,11 +779,11 @@ contains end subroutine psi_register_mpi_extras -!!$ subroutine psb_init_epk(ictxt,np,basectxt,ids) -!!$ type(psb_ctxt_type), intent(out) :: ictxt +!!$ subroutine psb_init_epk(ctxt,np,basectxt,ids) +!!$ type(psb_ctxt_type), intent(out) :: ctxt !!$ integer(psb_epk_), intent(in), optional :: np, basectxt, ids(:) !!$ -!!$ integer(psb_mpk_) :: iictxt +!!$ integer(psb_mpk_) :: ictxt !!$ integer(psb_mpk_) :: inp, ibasectxt !!$ integer(psb_mpk_), allocatable :: ids_(:) !!$ @@ -796,53 +796,53 @@ contains !!$ if (present(np).and.present(basectxt)) then !!$ inp = np !!$ ibasectxt = basectxt -!!$ call psb_init(ictxt,np=inp,basectxt=ibasectxt,ids=ids_) +!!$ call psb_init(ctxt,np=inp,basectxt=ibasectxt,ids=ids_) !!$ else if (present(np)) then !!$ inp = np -!!$ call psb_init(ictxt,np=inp,ids=ids_) +!!$ call psb_init(ctxt,np=inp,ids=ids_) !!$ else if (present(basectxt)) then !!$ ibasectxt = basectxt -!!$ call psb_init(ictxt,basectxt=ibasectxt,ids=ids_) +!!$ call psb_init(ctxt,basectxt=ibasectxt,ids=ids_) !!$ else -!!$ call psb_init(ictxt,ids=ids_) +!!$ call psb_init(ctxt,ids=ids_) !!$ end if !!$ end subroutine psb_init_epk -!!$ subroutine psb_exit_epk(ictxt,close) -!!$ integer(psb_epk_), intent(inout) :: ictxt +!!$ subroutine psb_exit_epk(ctxt,close) +!!$ integer(psb_epk_), intent(inout) :: ctxt !!$ logical, intent(in), optional :: close -!!$ integer(psb_mpk_) :: iictxt +!!$ integer(psb_mpk_) :: ictxt !!$ -!!$ iictxt = ictxt -!!$ call psb_exit(iictxt, close) +!!$ ictxt = ctxt +!!$ call psb_exit(ictxt, close) !!$ end subroutine psb_exit_epk !!$ -!!$ subroutine psb_barrier_epk(ictxt) -!!$ integer(psb_epk_), intent(in) :: ictxt -!!$ integer(psb_mpk_) :: iictxt +!!$ subroutine psb_barrier_epk(ctxt) +!!$ integer(psb_epk_), intent(in) :: ctxt +!!$ integer(psb_mpk_) :: ictxt !!$ -!!$ iictxt = ictxt -!!$ call psb_barrier(iictxt) +!!$ ictxt = ctxt +!!$ call psb_barrier(ictxt) !!$ end subroutine psb_barrier_epk !!$ -!!$ subroutine psb_abort_epk(ictxt,errc) -!!$ integer(psb_epk_), intent(in) :: ictxt +!!$ subroutine psb_abort_epk(ctxt,errc) +!!$ integer(psb_epk_), intent(in) :: ctxt !!$ integer(psb_epk_), intent(in), optional :: errc -!!$ integer(psb_mpk_) :: iictxt, ierrc +!!$ integer(psb_mpk_) :: ictxt, ierrc !!$ -!!$ iictxt = ictxt +!!$ ictxt = ctxt !!$ if (present(errc)) then !!$ ierrc = errc -!!$ call psb_abort(iictxt,ierrc) +!!$ call psb_abort(ictxt,ierrc) !!$ else -!!$ call psb_abort(iictxt) +!!$ call psb_abort(ictxt) !!$ end if !!$ end subroutine psb_abort_epk !!$ #if defined(IPK4) && defined(LPK8) - subroutine psb_info_epk(ictxt,iam,np) + subroutine psb_info_epk(ctxt,iam,np) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_epk_), intent(out) :: iam, np ! @@ -850,13 +850,13 @@ contains ! of the last CTXT encountered. ! integer(psb_mpk_), save :: lam, lnp - call psb_info(ictxt,lam,lnp) + call psb_info(ctxt,lam,lnp) iam = lam np = lnp end subroutine psb_info_epk #endif - subroutine psb_init_mpik(ictxt,np,basectxt,ids) + subroutine psb_init_mpik(ctxt,np,basectxt,ids) use psb_const_mod use psb_error_mod use psb_mat_mod @@ -869,7 +869,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(out) :: ictxt + type(psb_ctxt_type), intent(out) :: ctxt type(psb_ctxt_type), intent(in), optional :: basectxt integer(psb_mpk_), intent(in), optional :: np, ids(:) @@ -883,7 +883,7 @@ contains call psb_set_debug_unit(psb_err_unit) #if defined(SERIAL_MPI) - ictxt = nctxt + ctxt = nctxt nctxt = nctxt + 1 call psi_register_mpi_extras(info) @@ -914,7 +914,7 @@ contains iinfo=psb_err_initerror_neugh_procs_ call psb_errpush(iinfo,name) call psb_error() - !ictxt = mpi_comm_null + !ctxt = mpi_comm_null return endif call mpi_comm_size(basecomm,np_,info) @@ -922,32 +922,32 @@ contains iinfo=psb_err_initerror_neugh_procs_ call psb_errpush(iinfo,name) call psb_error() - !ictxt = mpi_comm_null + !ctxt = mpi_comm_null return endif call mpi_comm_group(basecomm,basegroup,info) if (present(ids)) then if (size(ids)np_)) then write(psb_err_unit,*) 'Error in init: invalid rank in input' - !ictxt%ctxt = mpi_comm_null + !ctxt%ctxt = mpi_comm_null return end if end do call mpi_group_incl(basegroup,np,ids,newgroup,info) if (info /= mpi_success) then - !ictxt%ctxt = mpi_comm_null + !ctxt%ctxt = mpi_comm_null return endif else allocate(iids(np),stat=info) if (info /= 0) then - !ictxt%ctxt = mpi_comm_null + !ctxt%ctxt = mpi_comm_null return endif do i=1, np @@ -955,7 +955,7 @@ contains end do call mpi_group_incl(basegroup,np,iids,newgroup,info) if (info /= mpi_success) then - !ictxt = mpi_comm_null + !ctxt = mpi_comm_null return endif deallocate(iids) @@ -967,16 +967,16 @@ contains if (basecomm /= mpi_comm_null) then call mpi_comm_dup(basecomm,icomm,info) else - ! ictxt = mpi_comm_null + ! ctxt = mpi_comm_null end if endif if (info == 0) then - ictxt%ctxt = icomm ! allocate on assignment + ctxt%ctxt = icomm ! allocate on assignment end if call psi_register_mpi_extras(info) call psi_get_sizes() - !if (ictxt == mpi_comm_null) return - if (.not.allocated(ictxt%ctxt)) return + !if (ctxt == mpi_comm_null) return + if (.not.allocated(ctxt%ctxt)) return #endif call psb_init_vect_defaults() call psb_init_mat_defaults() @@ -989,13 +989,13 @@ contains ! !$ ! or shall we tolerate this ? ! !$ info=psb_err_internal_error_ ! !$ call psb_errpush(info,name) - ! !$ call psb_error(ictxt) + ! !$ call psb_error(ctxt) ! !$ endif ! !$ endif end subroutine psb_init_mpik - subroutine psb_exit_mpik(ictxt,close) + subroutine psb_exit_mpik(ctxt,close) use psb_mat_mod use psb_vect_mod ! !$ use psb_rsb_mod @@ -1006,7 +1006,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(inout) :: ictxt + type(psb_ctxt_type), intent(inout) :: ctxt logical, intent(in), optional :: close logical :: close_ integer(psb_mpk_) :: info @@ -1025,22 +1025,22 @@ contains ! !$ else ! !$ info=psb_err_internal_error_ ! rsb failed to exit, and we issue an internal error. or shall we tolerate this ? ! !$ call psb_errpush(info,name) -! !$ call psb_error(ictxt) +! !$ call psb_error(ctxt) ! !$ endif ! !$ endif #if defined(SERIAL_MPI) ! Under serial mode, CLOSE has no effect, but reclaim - ! the used ICTXT number. + ! the used ctxt number. nctxt = max(0, nctxt - 1) #else if (close_) then call psb_close_all_context(psb_mesg_queue) else - call psb_close_context(psb_mesg_queue,ictxt) + call psb_close_context(psb_mesg_queue,ctxt) end if - !if ((ictxt /= mpi_comm_null).and.(ictxt /= mpi_comm_world)) then - if (allocated(ictxt%ctxt)) then - if (ictxt%ctxt /= mpi_comm_world)call mpi_comm_Free(ictxt%ctxt,info) + !if ((ctxt /= mpi_comm_null).and.(ctxt /= mpi_comm_world)) then + if (allocated(ctxt%ctxt)) then + if (ctxt%ctxt /= mpi_comm_world)call mpi_comm_Free(ctxt%ctxt,info) end if if (close_) call mpi_finalize(info) @@ -1052,7 +1052,7 @@ contains end subroutine psb_exit_mpik - subroutine psb_barrier_mpik(ictxt) + subroutine psb_barrier_mpik(ctxt) #ifdef MPI_MOD use mpi #endif @@ -1060,12 +1060,12 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_) :: info #if !defined(SERIAL_MPI) - if (allocated(ictxt%ctxt)) then - if (ictxt%ctxt /= mpi_comm_null) call mpi_barrier(ictxt%ctxt, info) + if (allocated(ctxt%ctxt)) then + if (ctxt%ctxt /= mpi_comm_null) call mpi_barrier(ctxt%ctxt, info) end if #endif @@ -1086,9 +1086,9 @@ contains psb_wtime = mpi_wtime() end function psb_wtime - subroutine psb_abort_mpik(ictxt,errc) + subroutine psb_abort_mpik(ctxt,errc) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(in), optional :: errc integer(psb_mpk_) :: code, info @@ -1102,13 +1102,13 @@ contains code = -1 endif - if (allocated(ictxt%ctxt)) call mpi_abort(ictxt%ctxt,code,info) + if (allocated(ctxt%ctxt)) call mpi_abort(ctxt%ctxt,code,info) #endif end subroutine psb_abort_mpik - subroutine psb_info_mpik(ictxt,iam,np) + subroutine psb_info_mpik(ctxt,iam,np) #ifdef MPI_MOD use mpi #endif @@ -1117,7 +1117,7 @@ contains include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_mpk_), intent(out) :: iam, np integer(psb_mpk_) :: info ! @@ -1132,18 +1132,18 @@ contains #else iam = -1 np = -1 - if (allocated(ictxt%ctxt)) then - if (ictxt%ctxt == lctxt) then + if (allocated(ctxt%ctxt)) then + if (ctxt%ctxt == lctxt) then iam = lam np = lnp else - if (ictxt%ctxt /= mpi_comm_null) then - call mpi_comm_size(ictxt%ctxt,np,info) + if (ctxt%ctxt /= mpi_comm_null) then + call mpi_comm_size(ctxt%ctxt,np,info) if (info /= mpi_success) np = -1 - call mpi_comm_rank(ictxt%ctxt,iam,info) + call mpi_comm_rank(ctxt%ctxt,iam,info) if (info /= mpi_success) iam = -1 end if - lctxt = ictxt%ctxt + lctxt = ctxt%ctxt lam = iam lnp = np end if @@ -1152,33 +1152,33 @@ contains end subroutine psb_info_mpik - function psb_m_get_mpi_comm(ictxt) result(comm) - type(psb_ctxt_type) :: ictxt + function psb_m_get_mpi_comm(ctxt) result(comm) + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: comm comm = mpi_comm_null - if (allocated(ictxt%ctxt)) comm = ictxt%ctxt + if (allocated(ctxt%ctxt)) comm = ctxt%ctxt end function psb_m_get_mpi_comm - function psb_m_get_mpi_rank(ictxt,id) result(rank) + function psb_m_get_mpi_rank(ctxt,id) result(rank) integer(psb_mpk_) :: rank integer(psb_mpk_) :: id - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt rank = id end function psb_m_get_mpi_rank - subroutine psb_get_mpicomm(ictxt,comm) - type(psb_ctxt_type) :: ictxt + subroutine psb_get_mpicomm(ctxt,comm) + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: comm comm = mpi_comm_null - if (allocated(ictxt%ctxt)) comm = ictxt%ctxt + if (allocated(ctxt%ctxt)) comm = ctxt%ctxt end subroutine psb_get_mpicomm - subroutine psb_get_rank(rank,ictxt,id) - type(psb_ctxt_type) :: ictxt + subroutine psb_get_rank(rank,ctxt,id) + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: rank,id - rank = psb_get_mpi_rank(ictxt,id) + rank = psb_get_mpi_rank(ctxt,id) end subroutine psb_get_rank diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index a9a249ee..30a10524 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -91,7 +91,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_smaxs(ictxt,dat,root) + subroutine psb_smaxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -99,7 +99,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -109,14 +109,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_max,icomm,info) dat = dat_ @@ -127,7 +127,7 @@ contains #endif end subroutine psb_smaxs - subroutine psb_smaxv(ictxt,dat,root) + subroutine psb_smaxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -136,7 +136,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -146,14 +146,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -172,7 +172,7 @@ contains #endif end subroutine psb_smaxv - subroutine psb_smaxm(ictxt,dat,root) + subroutine psb_smaxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -191,14 +191,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -222,7 +222,7 @@ contains ! - subroutine psb_smins(ictxt,dat,root) + subroutine psb_smins(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -230,7 +230,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -240,14 +240,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_min,icomm,info) dat = dat_ @@ -258,7 +258,7 @@ contains #endif end subroutine psb_smins - subroutine psb_sminv(ictxt,dat,root) + subroutine psb_sminv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -267,7 +267,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -277,14 +277,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -303,7 +303,7 @@ contains #endif end subroutine psb_sminv - subroutine psb_sminm(ictxt,dat,root) + subroutine psb_sminm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -312,7 +312,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -322,14 +322,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -354,7 +354,7 @@ contains ! Norm 2, only for reals ! ! !!!!!!!!!!!! - subroutine psb_s_nrm2s(ictxt,dat,root) + subroutine psb_s_nrm2s(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -362,7 +362,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -372,14 +372,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_snrm2_op,icomm,info) dat = dat_ @@ -390,7 +390,7 @@ contains #endif end subroutine psb_s_nrm2s - subroutine psb_s_nrm2v(ictxt,dat,root) + subroutine psb_s_nrm2v(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -399,7 +399,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -409,14 +409,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -443,7 +443,7 @@ contains ! SUM ! - subroutine psb_ssums(ictxt,dat,root) + subroutine psb_ssums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -451,7 +451,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -460,14 +460,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,info) dat = dat_ @@ -478,7 +478,7 @@ contains #endif end subroutine psb_ssums - subroutine psb_ssumv(ictxt,dat,root) + subroutine psb_ssumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -487,7 +487,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -496,14 +496,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -522,7 +522,7 @@ contains #endif end subroutine psb_ssumv - subroutine psb_ssumm(ictxt,dat,root) + subroutine psb_ssumm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -531,7 +531,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -541,14 +541,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -571,7 +571,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_samxs(ictxt,dat,root) + subroutine psb_samxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -579,7 +579,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -588,14 +588,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samx_op,icomm,info) dat = dat_ @@ -606,7 +606,7 @@ contains #endif end subroutine psb_samxs - subroutine psb_samxv(ictxt,dat,root) + subroutine psb_samxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -615,7 +615,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -624,14 +624,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -650,7 +650,7 @@ contains #endif end subroutine psb_samxv - subroutine psb_samxm(ictxt,dat,root) + subroutine psb_samxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -659,7 +659,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -669,14 +669,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -699,7 +699,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_samns(ictxt,dat,root) + subroutine psb_samns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -707,7 +707,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -716,14 +716,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_r_spk_,mpi_samn_op,icomm,info) dat = dat_ @@ -734,7 +734,7 @@ contains #endif end subroutine psb_samns - subroutine psb_samnv(ictxt,dat,root) + subroutine psb_samnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -743,7 +743,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -752,14 +752,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -778,7 +778,7 @@ contains #endif end subroutine psb_samnv - subroutine psb_samnm(ictxt,dat,root) + subroutine psb_samnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -787,7 +787,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -797,14 +797,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -827,7 +827,7 @@ contains ! BCAST Broadcast ! - subroutine psb_sbcasts(ictxt,dat,root) + subroutine psb_sbcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -835,7 +835,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -844,20 +844,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_r_spk_,root_,icomm,info) #endif end subroutine psb_sbcasts - subroutine psb_sbcastv(ictxt,dat,root) + subroutine psb_sbcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -866,7 +866,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -874,19 +874,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,icomm,info) #endif end subroutine psb_sbcastv - subroutine psb_sbcastm(ictxt,dat,root) + subroutine psb_sbcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -895,7 +895,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -905,14 +905,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_r_spk_,root_,icomm,info) #endif end subroutine psb_sbcastm @@ -923,7 +923,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_sscan_sums(ictxt,dat) + subroutine psb_sscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -931,22 +931,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_sscan_sums - subroutine psb_sexscan_sums(ictxt,dat) + subroutine psb_sexscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -954,7 +954,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -962,8 +962,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -971,7 +971,7 @@ contains #endif end subroutine psb_sexscan_sums - subroutine psb_sscan_sumv(ictxt,dat,root) + subroutine psb_sscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -980,7 +980,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -989,8 +989,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -998,7 +998,7 @@ contains #endif end subroutine psb_sscan_sumv - subroutine psb_sexscan_sumv(ictxt,dat,root) + subroutine psb_sexscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -1007,7 +1007,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -1016,8 +1016,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -1028,17 +1028,17 @@ contains end subroutine psb_sexscan_sumv subroutine psb_s_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_s_p2p_mod implicit none real(psb_spk_), intent(in) :: valsnd(:) real(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -1057,14 +1057,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_s_simple_a2av subroutine psb_s_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1077,7 +1077,7 @@ contains real(psb_spk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1085,9 +1085,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_real_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1119,7 +1119,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_real_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -1147,7 +1147,7 @@ contains end subroutine psb_s_m_simple_triad_a2av subroutine psb_s_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -1160,7 +1160,7 @@ contains real(psb_spk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -1168,9 +1168,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_real_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -1202,7 +1202,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_real_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_s_p2p_mod.F90 b/base/modules/penv/psi_s_p2p_mod.F90 index 12c19c6e..9c7f9d66 100644 --- a/base/modules/penv/psi_s_p2p_mod.F90 +++ b/base/modules/penv/psi_s_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_s_p2p_mod contains - subroutine psb_ssnds(ictxt,dat,dst) + subroutine psb_ssnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst real(psb_spk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_real_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_ssnds - subroutine psb_ssndv(ictxt,dat,dst) + subroutine psb_ssndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst real(psb_spk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_real_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_ssndv - subroutine psb_ssndm(ictxt,dat,dst,m) + subroutine psb_ssndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_real_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_real_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_ssndm - subroutine psb_srcvs(ictxt,dat,src) + subroutine psb_srcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_srcvs - subroutine psb_srcvv(ictxt,dat,src) + subroutine psb_srcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src real(psb_spk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_srcvv - subroutine psb_srcvm(ictxt,dat,src,m) + subroutine psb_srcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt real(psb_spk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_r_spk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_real_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index a1d43252..80c9213a 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -79,7 +79,7 @@ contains ! SUM ! - subroutine psb_zsums(ictxt,dat,root) + subroutine psb_zsums(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -87,7 +87,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -96,14 +96,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,info) dat = dat_ @@ -114,7 +114,7 @@ contains #endif end subroutine psb_zsums - subroutine psb_zsumv(ictxt,dat,root) + subroutine psb_zsumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -123,7 +123,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -132,14 +132,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -158,7 +158,7 @@ contains #endif end subroutine psb_zsumv - subroutine psb_zsumm(ictxt,dat,root) + subroutine psb_zsumm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -167,7 +167,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -177,14 +177,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -207,7 +207,7 @@ contains ! AMX: Maximum Absolute Value ! - subroutine psb_zamxs(ictxt,dat,root) + subroutine psb_zamxs(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -215,7 +215,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -224,14 +224,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamx_op,icomm,info) dat = dat_ @@ -242,7 +242,7 @@ contains #endif end subroutine psb_zamxs - subroutine psb_zamxv(ictxt,dat,root) + subroutine psb_zamxv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -251,7 +251,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -260,14 +260,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -286,7 +286,7 @@ contains #endif end subroutine psb_zamxv - subroutine psb_zamxm(ictxt,dat,root) + subroutine psb_zamxm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -295,7 +295,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -305,14 +305,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -335,7 +335,7 @@ contains ! AMN: Minimum Absolute Value ! - subroutine psb_zamns(ictxt,dat,root) + subroutine psb_zamns(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -343,7 +343,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -352,14 +352,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call mpi_allreduce(dat,dat_,1,psb_mpi_c_dpk_,mpi_zamn_op,icomm,info) dat = dat_ @@ -370,7 +370,7 @@ contains #endif end subroutine psb_zamns - subroutine psb_zamnv(ictxt,dat,root) + subroutine psb_zamnv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -379,7 +379,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -388,14 +388,14 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat),dat_,iinfo) dat_ = dat @@ -414,7 +414,7 @@ contains #endif end subroutine psb_zamnv - subroutine psb_zamnm(ictxt,dat,root) + subroutine psb_zamnm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -423,7 +423,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -433,14 +433,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = -1 endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,iinfo) dat_ = dat @@ -463,7 +463,7 @@ contains ! BCAST Broadcast ! - subroutine psb_zbcasts(ictxt,dat,root) + subroutine psb_zbcasts(ctxt,dat,root) #ifdef MPI_MOD use mpi #endif @@ -471,7 +471,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -480,20 +480,20 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,1,psb_mpi_c_dpk_,root_,icomm,info) #endif end subroutine psb_zbcasts - subroutine psb_zbcastv(ictxt,dat,root) + subroutine psb_zbcastv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -502,7 +502,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -510,19 +510,19 @@ contains integer(psb_ipk_) :: iinfo #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info) #endif end subroutine psb_zbcastv - subroutine psb_zbcastm(ictxt,dat,root) + subroutine psb_zbcastm(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -531,7 +531,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:,:) integer(psb_mpk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -541,14 +541,14 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (present(root)) then root_ = root else root_ = psb_root_ endif - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_bcast(dat,size(dat),psb_mpi_c_dpk_,root_,icomm,info) #endif end subroutine psb_zbcastm @@ -559,7 +559,7 @@ contains ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine psb_zscan_sums(ictxt,dat) + subroutine psb_zscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -567,22 +567,22 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_zscan_sums - subroutine psb_zexscan_sums(ictxt,dat) + subroutine psb_zexscan_sums(ctxt,dat) #ifdef MPI_MOD use mpi #endif @@ -590,7 +590,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ integer(psb_ipk_) :: iam, np, info @@ -598,8 +598,8 @@ contains #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) dat = dat_ #else @@ -607,7 +607,7 @@ contains #endif end subroutine psb_zexscan_sums - subroutine psb_zscan_sumv(ictxt,dat,root) + subroutine psb_zscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -616,7 +616,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -625,8 +625,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -634,7 +634,7 @@ contains #endif end subroutine psb_zscan_sumv - subroutine psb_zexscan_sumv(ictxt,dat,root) + subroutine psb_zexscan_sumv(ctxt,dat,root) use psb_realloc_mod #ifdef MPI_MOD use mpi @@ -643,7 +643,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(inout) :: dat(:) integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ @@ -652,8 +652,8 @@ contains integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) - call psb_info(ictxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + call psb_info(ctxt,iam,np) + icomm = psb_get_mpi_comm(ctxt) call psb_realloc(size(dat),dat_,info) dat_ = dat if (info == psb_success_) & @@ -664,17 +664,17 @@ contains end subroutine psb_zexscan_sumv subroutine psb_z_simple_a2av(valsnd,sdsz,bsdindx,& - & valrcv,rvsz,brvindx,ictxt,info) + & valrcv,rvsz,brvindx,ctxt,info) use psi_z_p2p_mod implicit none complex(psb_dpk_), intent(in) :: valsnd(:) complex(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: iam, np, i,j,k, ip, ipx, idx, sz - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then idx = bsdindx(ip+1) - call psb_snd(ictxt,valsnd(idx+1:idx+sz),ip) + call psb_snd(ctxt,valsnd(idx+1:idx+sz),ip) end if end do @@ -693,14 +693,14 @@ contains sz = rvsz(ip+1) if (sz > 0) then idx = brvindx(ip+1) - call psb_rcv(ictxt,valrcv(idx+1:idx+sz),ip) + call psb_rcv(ctxt,valrcv(idx+1:idx+sz),ip) end if end do end subroutine psb_z_simple_a2av subroutine psb_z_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -713,7 +713,7 @@ contains complex(psb_dpk_), intent(out) :: valrcv(:) integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -721,9 +721,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -755,7 +755,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& @@ -783,7 +783,7 @@ contains end subroutine psb_z_m_simple_triad_a2av subroutine psb_z_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & valrcv,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info) #ifdef MPI_MOD use mpi #endif @@ -796,7 +796,7 @@ contains complex(psb_dpk_), intent(out) :: valrcv(:) integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info !Local variables @@ -804,9 +804,9 @@ contains integer(psb_mpk_) :: proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret, icomm integer(psb_mpk_), allocatable :: prcid(:), rvhd(:,:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (min(size(bsdindx),size(brvindx),size(sdsz),size(rvsz)) 0) then - prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_irecv(valrcv(idx+1:idx+sz),sz,& @@ -838,7 +838,7 @@ contains do ip = 0, np-1 sz = sdsz(ip+1) if (sz > 0) then - if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ictxt,ip) + if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_z_p2p_mod.F90 b/base/modules/penv/psi_z_p2p_mod.F90 index 7761b83d..cf12d978 100644 --- a/base/modules/penv/psi_z_p2p_mod.F90 +++ b/base/modules/penv/psi_z_p2p_mod.F90 @@ -43,7 +43,7 @@ module psi_z_p2p_mod contains - subroutine psb_zsnds(ictxt,dat,dst) + subroutine psb_zsnds(ctxt,dat,dst) #ifdef MPI_MOD use mpi #endif @@ -51,7 +51,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(in) :: dat integer(psb_mpk_), intent(in) :: dst complex(psb_dpk_), allocatable :: dat_(:) @@ -61,11 +61,11 @@ contains #else allocate(dat_(1), stat=info) dat_(1) = dat - call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_zsnds - subroutine psb_zsndv(ictxt,dat,dst) + subroutine psb_zsndv(ctxt,dat,dst) #ifdef MPI_MOD use mpi @@ -74,7 +74,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(in) :: dat(:) integer(psb_mpk_), intent(in) :: dst complex(psb_dpk_), allocatable :: dat_(:) @@ -84,12 +84,12 @@ contains #else allocate(dat_(size(dat)), stat=info) dat_(:) = dat(:) - call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_zsndv - subroutine psb_zsndm(ictxt,dat,dst,m) + subroutine psb_zsndm(ctxt,dat,dst,m) #ifdef MPI_MOD use mpi @@ -98,7 +98,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(in) :: dat(:,:) integer(psb_mpk_), intent(in) :: dst integer(psb_ipk_), intent(in), optional :: m @@ -122,11 +122,11 @@ contains k = k + 1 end do end do - call psi_snd(ictxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) + call psi_snd(ctxt,psb_dcomplex_tag,dst,dat_,psb_mesg_queue) #endif end subroutine psb_zsndm - subroutine psb_zrcvs(ictxt,dat,src) + subroutine psb_zrcvs(ctxt,dat,src) #ifdef MPI_MOD use mpi #endif @@ -134,7 +134,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(out) :: dat integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info, icomm @@ -142,13 +142,13 @@ contains #if defined(SERIAL_MPI) ! do nothing #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,1,psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_zrcvs - subroutine psb_zrcvv(ictxt,dat,src) + subroutine psb_zrcvv(ctxt,dat,src) #ifdef MPI_MOD use mpi @@ -157,7 +157,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src complex(psb_dpk_), allocatable :: dat_(:) @@ -165,14 +165,14 @@ contains integer(psb_mpk_) :: status(mpi_status_size) #if defined(SERIAL_MPI) #else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif end subroutine psb_zrcvv - subroutine psb_zrcvm(ictxt,dat,src,m) + subroutine psb_zrcvm(ctxt,dat,src,m) #ifdef MPI_MOD use mpi @@ -181,7 +181,7 @@ contains #ifdef MPI_H include 'mpif.h' #endif - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt complex(psb_dpk_), intent(out) :: dat(:,:) integer(psb_mpk_), intent(in) :: src integer(psb_ipk_), intent(in), optional :: m @@ -198,12 +198,12 @@ contains n_ = size(dat,2) call mpi_type_vector(n_,m_,ld,psb_mpi_c_dpk_,mp_rcv_type,info) if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info) - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,& & psb_dcomplex_tag,icomm,status,info) if (info == mpi_success) call mpi_type_free(mp_rcv_type,info) else - icomm = psb_get_mpi_comm(ictxt) + icomm = psb_get_mpi_comm(ctxt) call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info) end if if (info /= mpi_success) then diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index c8ed484a..dee01457 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -78,7 +78,7 @@ module psb_const_mod ! ! Additional rules: ! 1. MPI related stuff is always MPK - ! 2. ICTXT,IAM,NP: should we have two versions of everything, + ! 2. ctxt,IAM,NP: should we have two versions of everything, ! one with MPK the other with EPK? ! 3. INFO, ERR_ACT, IERR etc are always IPK ! 4. For the array version of things, where it makes sense diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index e8f58dd8..b85c48e9 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -1,23 +1,23 @@ ! checks wether an error has occurred on one of the porecesses in the execution pool -subroutine psb_errcomm_i(ictxt, err) +subroutine psb_errcomm_i(ctxt, err) use psb_error_mod, psb_protect_name => psb_errcomm use psb_penv_mod - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(inout) :: err - if (psb_get_global_checks()) call psb_amx(ictxt, err) + if (psb_get_global_checks()) call psb_amx(ctxt, err) end subroutine psb_errcomm_i #if defined(IPK8) -subroutine psb_errcomm_m(ictxt, err) +subroutine psb_errcomm_m(ctxt, err) use psb_error_mod, psb_protect_name => psb_errcomm use psb_penv_mod - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(inout) :: err - if (psb_get_global_checks()) call psb_amx(ictxt, err) + if (psb_get_global_checks()) call psb_amx(ctxt, err) end subroutine psb_errcomm_m #endif @@ -37,30 +37,30 @@ subroutine psb_ser_error_handler(err_act) return end subroutine psb_ser_error_handler -subroutine psb_par_error_handler(ictxt,err_act) +subroutine psb_par_error_handler(ctxt,err_act) use psb_error_mod, psb_protect_name => psb_par_error_handler use psb_penv_mod implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: err_act call psb_erractionrestore(err_act) if (err_act == psb_act_print_) & - & call psb_error(ictxt, abrt=.false.) + & call psb_error(ctxt, abrt=.false.) if (err_act == psb_act_abort_) & - & call psb_error(ictxt, abrt=.true.) + & call psb_error(ctxt, abrt=.true.) return end subroutine psb_par_error_handler -subroutine psb_par_error_print_stack(ictxt) +subroutine psb_par_error_print_stack(ctxt) use psb_error_mod, psb_protect_name => psb_par_error_print_stack use psb_penv_mod - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt - call psb_error(ictxt, abrt=.false.) + call psb_error(ctxt, abrt=.false.) end subroutine psb_par_error_print_stack @@ -111,12 +111,12 @@ end subroutine psb_serror ! handles the occurence of an error in a parallel routine -subroutine psb_perror(ictxt,abrt) +subroutine psb_perror(ctxt,abrt) use psb_const_mod use psb_error_mod use psb_penv_mod implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(in), optional :: abrt integer(psb_ipk_) :: err_c @@ -128,7 +128,7 @@ subroutine psb_perror(ictxt,abrt) abrt_=.true. if (present(abrt)) abrt_=abrt - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (psb_errstatus_fatal()) then if (psb_get_errverbosity() > 1) then @@ -143,7 +143,7 @@ subroutine psb_perror(ictxt,abrt) flush(psb_err_unit) #endif - if (abrt_) call psb_abort(ictxt,-1) + if (abrt_) call psb_abort(ctxt,-1) else @@ -156,7 +156,7 @@ subroutine psb_perror(ictxt,abrt) flush(psb_err_unit) #endif - if (abrt_) call psb_abort(ictxt,-1) + if (abrt_) call psb_abort(ctxt,-1) end if end if diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index 75988639..fe12fca4 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -71,9 +71,9 @@ module psb_error_mod import :: psb_ipk_ integer(psb_ipk_), intent(inout) :: err_act end subroutine psb_ser_error_handler - subroutine psb_par_error_handler(ictxt,err_act) + subroutine psb_par_error_handler(ctxt,err_act) import :: psb_ipk_,psb_mpk_, psb_ctxt_type - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: err_act end subroutine psb_par_error_handler end interface @@ -81,18 +81,18 @@ module psb_error_mod interface psb_error subroutine psb_serror() end subroutine psb_serror - subroutine psb_perror(ictxt,abrt) + subroutine psb_perror(ctxt,abrt) import :: psb_ipk_, psb_ctxt_type - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt logical, intent(in), optional :: abrt end subroutine psb_perror end interface interface psb_error_print_stack - subroutine psb_par_error_print_stack(ictxt) + subroutine psb_par_error_print_stack(ctxt) import :: psb_ipk_, psb_ctxt_type - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt end subroutine psb_par_error_print_stack subroutine psb_ser_error_print_stack() end subroutine psb_ser_error_print_stack @@ -100,15 +100,15 @@ module psb_error_mod interface psb_errcomm #if defined(IPK8) - subroutine psb_errcomm_m(ictxt, err) + subroutine psb_errcomm_m(ctxt, err) import :: psb_ipk_, psb_mpk_, psb_ctxt_type - type(pxb_ctxt_type), intent(in) :: ictxt + type(pxb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(inout) :: err end subroutine psb_errcomm_m #endif - subroutine psb_errcomm_i(ictxt, err) + subroutine psb_errcomm_i(ctxt, err) import :: psb_ipk_, psb_ctxt_type - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(inout) :: err end subroutine psb_errcomm_i end interface psb_errcomm diff --git a/base/modules/psb_timers_mod.f90 b/base/modules/psb_timers_mod.f90 index 69428558..6bf95466 100644 --- a/base/modules/psb_timers_mod.f90 +++ b/base/modules/psb_timers_mod.f90 @@ -95,9 +95,9 @@ contains end subroutine print_timer - subroutine psb_print_timers(ictxt, idx, proc, global, iout) + subroutine psb_print_timers(ctxt, idx, proc, global, iout) implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in), optional :: idx, proc, iout logical, optional :: global ! @@ -108,7 +108,7 @@ contains real(psb_dpk_), allocatable :: ptimers(:,:) logical :: global_ - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (present(global)) then global_ = global else @@ -132,10 +132,10 @@ contains allocate(ptimers(timer_entries_,size(timers,2)),stat=info) if (info /= 0) then write(0,*) 'Error while trying to allocate temporary ',info - call psb_abort(ictxt) + call psb_abort(ctxt) end if ptimers = timers - call psb_max(ictxt,ptimers) + call psb_max(ctxt,ptimers) if (me == psb_root_) then do i=idxmin_, idxmax_ call print_timer(me, ptimers(:,i), timers_descr(i), iout) diff --git a/base/modules/psi_i_mod.F90 b/base/modules/psi_i_mod.F90 index 04d74be6..bcbc1bb6 100644 --- a/base/modules/psi_i_mod.F90 +++ b/base/modules/psi_i_mod.F90 @@ -84,23 +84,23 @@ module psi_i_mod end interface interface psi_sort_dl - subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) + subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ctxt,info) import implicit none integer(psb_ipk_), intent(in) :: c_dep_list(:), dl_ptr(0:) integer(psb_ipk_), intent(inout) :: l_dep_list(0:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info end subroutine psi_i_csr_sort_dl end interface interface psi_extract_dep_list - subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& + subroutine psi_i_extract_dep_list(ctxt,is_bld,is_upd,desc_str,dep_list,& & length_dl,dl_lda,mode,info) import implicit none logical, intent(in) :: is_bld, is_upd - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_), intent(in) :: mode integer(psb_ipk_), intent(out) :: dl_lda integer(psb_ipk_), intent(in) :: desc_str(*) @@ -110,17 +110,17 @@ module psi_i_mod end interface interface psi_bld_glb_dep_list -!!$ subroutine psi_i_bld_glb_dep_list(ictxt,loc_dl,length_dl,dep_list,dl_lda,info) +!!$ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,dep_list,dl_lda,info) !!$ import -!!$ type(psb_ctxt_type), intent(in) :: ictxt +!!$ type(psb_ctxt_type), intent(in) :: ctxt !!$ integer(psb_ipk_), intent(out) :: dl_lda !!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) !!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) !!$ integer(psb_ipk_), intent(out) :: info !!$ end subroutine psi_i_bld_glb_dep_list - subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) + subroutine psi_i_bld_glb_csr_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) import - integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) integer(psb_ipk_), intent(out) :: info @@ -128,10 +128,10 @@ module psi_i_mod end interface interface psi_extract_loc_dl - subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) + subroutine psi_i_xtr_loc_dl(ctxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info) import logical, intent(in) :: is_bld, is_upd - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: desc_str(:) integer(psb_ipk_), allocatable, intent(out) :: loc_dl(:), length_dl(:) integer(psb_ipk_), intent(out) :: info diff --git a/base/modules/tools/psb_cd_tools_mod.F90 b/base/modules/tools/psb_cd_tools_mod.F90 index e7efae9c..df4c02a1 100644 --- a/base/modules/tools/psb_cd_tools_mod.F90 +++ b/base/modules/tools/psb_cd_tools_mod.F90 @@ -190,13 +190,13 @@ module psb_cd_tools_mod interface psb_cdall - subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,& + subroutine psb_cdall(ctxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,& & globalcheck,lidx,usehash) import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts, psb_ctxt_type implicit None procedure(psb_parts) :: parts integer(psb_lpk_), intent(in) :: mg,ng, vl(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_), intent(in) :: vg(:), lidx(:),nl integer(psb_ipk_), intent(in) :: flag logical, intent(in) :: repl, globalcheck, usehash diff --git a/base/psblas/psb_cabs_vect.f90 b/base/psblas/psb_cabs_vect.f90 index f70f9a46..cb192195 100644 --- a/base/psblas/psb_cabs_vect.f90 +++ b/base/psblas/psb_cabs_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_cabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_cabs_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_cabs_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_camax.f90 b/base/psblas/psb_camax.f90 index 2347eb80..e30ba8fe 100644 --- a/base/psblas/psb_camax.f90 +++ b/base/psblas/psb_camax.f90 @@ -57,7 +57,7 @@ function psb_camax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_camax(x,desc_a, info, jx,global) result(res) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -119,12 +119,12 @@ function psb_camax(x,desc_a, info, jx,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_camax @@ -186,7 +186,7 @@ function psb_camaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -201,9 +201,9 @@ function psb_camaxv (x,desc_a, info,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -244,12 +244,12 @@ function psb_camaxv (x,desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_camaxv @@ -282,7 +282,7 @@ function psb_camax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -296,9 +296,9 @@ function psb_camax_vect(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -343,12 +343,12 @@ function psb_camax_vect(x, desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_camaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -427,9 +427,9 @@ subroutine psb_camaxvs(res,x,desc_a, info,global) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -469,12 +469,12 @@ subroutine psb_camaxvs(res,x,desc_a, info,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_camaxvs @@ -536,7 +536,7 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -550,9 +550,9 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -598,12 +598,12 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res(1:k)) + if (global_) call psb_amx(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cmamaxs diff --git a/base/psblas/psb_casum.f90 b/base/psblas/psb_casum.f90 index 3edfb637..7b9b3275 100644 --- a/base/psblas/psb_casum.f90 +++ b/base/psblas/psb_casum.f90 @@ -57,7 +57,7 @@ function psb_casum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_casum (x,desc_a, info, jx,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -126,12 +126,12 @@ function psb_casum (x,desc_a, info, jx,global) result(res) res = szero end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_casum @@ -161,7 +161,7 @@ function psb_casum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -176,9 +176,9 @@ function psb_casum_vect(x, desc_a, info,global) result(res) call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -232,12 +232,12 @@ function psb_casum_vect(x, desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -299,7 +299,7 @@ function psb_casumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -313,9 +313,9 @@ function psb_casumv(x,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -364,12 +364,12 @@ function psb_casumv(x,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_casumv @@ -431,7 +431,7 @@ subroutine psb_casumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -445,9 +445,9 @@ subroutine psb_casumvs(res,x,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -496,12 +496,12 @@ subroutine psb_casumvs(res,x,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt,res) + if (global_) call psb_sum(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_casumvs diff --git a/base/psblas/psb_caxpby.f90 b/base/psblas/psb_caxpby.f90 index b37f9a6d..9ac48603 100644 --- a/base/psblas/psb_caxpby.f90 +++ b/base/psblas/psb_caxpby.f90 @@ -59,7 +59,7 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -70,9 +70,9 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -193,7 +193,7 @@ subroutine psb_caxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -204,9 +204,9 @@ subroutine psb_caxpby_vect_out(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -271,7 +271,7 @@ subroutine psb_caxpby_vect_out(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -310,7 +310,7 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) complex(psb_spk_), intent(inout) :: y(:,:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -323,8 +323,8 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -393,7 +393,7 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_caxpby @@ -459,7 +459,7 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info) complex(psb_spk_), intent(inout) :: y(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -473,9 +473,9 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -518,7 +518,7 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_caxpbyv @@ -582,7 +582,7 @@ subroutine psb_caxpbyvout(alpha, x, beta,y, z, desc_a,info) complex(psb_spk_), intent(inout) :: z(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -596,9 +596,9 @@ subroutine psb_caxpbyvout(alpha, x, beta,y, z, desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -650,7 +650,7 @@ subroutine psb_caxpbyvout(alpha, x, beta,y, z, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_caxpbyvout @@ -678,7 +678,7 @@ subroutine psb_caddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -689,9 +689,9 @@ subroutine psb_caddconst_vect(x,b,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -736,7 +736,7 @@ subroutine psb_caddconst_vect(x,b,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_ccmp_vect.f90 b/base/psblas/psb_ccmp_vect.f90 index f8442d97..5de95513 100644 --- a/base/psblas/psb_ccmp_vect.f90 +++ b/base/psblas/psb_ccmp_vect.f90 @@ -41,7 +41,7 @@ subroutine psb_ccmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -52,9 +52,9 @@ subroutine psb_ccmp_vect(x,c,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_ccmp_vect(x,c,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -116,7 +116,7 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -131,8 +131,8 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,16 +146,16 @@ subroutine psb_ccmp_spmatval(a,val,tol,desc_a,res,info) res = a%spcmp(val,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ccmp_spmatval @@ -171,7 +171,7 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -186,8 +186,8 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -203,17 +203,17 @@ subroutine psb_ccmp_spmat(a,b,tol,desc_a,res,info) res = a%spcmp(b,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_cdiv_vect.f90 b/base/psblas/psb_cdiv_vect.f90 index 5149d1e2..0fe4594a 100644 --- a/base/psblas/psb_cdiv_vect.f90 +++ b/base/psblas/psb_cdiv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_cdiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_cdiv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_cdiv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -115,7 +115,7 @@ subroutine psb_cdiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -126,9 +126,9 @@ subroutine psb_cdiv_vect2(x,y,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -187,7 +187,7 @@ subroutine psb_cdiv_vect2(x,y,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -203,7 +203,7 @@ subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -214,9 +214,9 @@ subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -262,7 +262,7 @@ subroutine psb_cdiv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -279,7 +279,7 @@ subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -290,9 +290,9 @@ subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -350,7 +350,7 @@ subroutine psb_cdiv_vect2_check(x,y,z,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_cdot.f90 b/base/psblas/psb_cdot.f90 index 6d012e77..ed300b7c 100644 --- a/base/psblas/psb_cdot.f90 +++ b/base/psblas/psb_cdot.f90 @@ -64,7 +64,7 @@ function psb_cdot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -79,8 +79,8 @@ function psb_cdot_vect(x, y, desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -147,12 +147,12 @@ function psb_cdot_vect(x, y, desc_a,info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -188,7 +188,7 @@ function psb_cdot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -203,8 +203,8 @@ function psb_cdot(x, y,desc_a, info, jx, jy,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -272,12 +272,12 @@ function psb_cdot(x, y,desc_a, info, jx, jy,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cdot @@ -340,7 +340,7 @@ function psb_cdotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -355,9 +355,9 @@ function psb_cdotv(x, y,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -408,13 +408,13 @@ function psb_cdotv(x, y,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cdotv @@ -477,7 +477,7 @@ subroutine psb_cdotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -492,9 +492,9 @@ subroutine psb_cdotvs(res, x, y,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -543,12 +543,12 @@ subroutine psb_cdotvs(res, x, y,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cdotvs @@ -612,7 +612,7 @@ subroutine psb_cmdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -627,9 +627,9 @@ subroutine psb_cmdots(res, x, y, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -690,12 +690,12 @@ subroutine psb_cmdots(res, x, y, desc_a, info,global) ! compute global sum - if (global_) call psb_sum(ictxt, res(1:k)) + if (global_) call psb_sum(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cmdots diff --git a/base/psblas/psb_cgetmatinfo.f90 b/base/psblas/psb_cgetmatinfo.f90 index c5e59862..f9c77166 100644 --- a/base/psblas/psb_cgetmatinfo.f90 +++ b/base/psblas/psb_cgetmatinfo.f90 @@ -47,7 +47,7 @@ function psb_cget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz @@ -60,8 +60,8 @@ function psb_cget_nnz(a,desc_a,info) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -70,12 +70,12 @@ function psb_cget_nnz(a,desc_a,info) result(res) localnnz = a%get_nzeros() - call psb_sum(ictxt,localnnz) + call psb_sum(ctxt,localnnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function diff --git a/base/psblas/psb_cinv_vect.f90 b/base/psblas/psb_cinv_vect.f90 index 6dea51b3..25589f32 100644 --- a/base/psblas/psb_cinv_vect.f90 +++ b/base/psblas/psb_cinv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_cinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_cinv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_cinv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -116,7 +116,7 @@ subroutine psb_cinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -127,9 +127,9 @@ subroutine psb_cinv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -178,7 +178,7 @@ subroutine psb_cinv_vect_check(x,y,desc_a,info,flag) check = .TRUE. end if - call psb_lallreduceand(ictxt,check) + call psb_lallreduceand(ctxt,check) if (check) then info = 1_psb_ipk_ @@ -189,7 +189,7 @@ subroutine psb_cinv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_cmlt_vect.f90 b/base/psblas/psb_cmlt_vect.f90 index 2e7743ff..9b4037bf 100644 --- a/base/psblas/psb_cmlt_vect.f90 +++ b/base/psblas/psb_cmlt_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_cmlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_cmlt_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_cmlt_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -121,7 +121,7 @@ subroutine psb_cmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -132,9 +132,9 @@ subroutine psb_cmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_cmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_cnrm2.f90 b/base/psblas/psb_cnrm2.f90 index e5eac8e6..8a803a4d 100644 --- a/base/psblas/psb_cnrm2.f90 +++ b/base/psblas/psb_cnrm2.f90 @@ -60,7 +60,7 @@ function psb_cnrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -75,9 +75,9 @@ function psb_cnrm2(x, desc_a, info, jx,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -127,12 +127,12 @@ function psb_cnrm2(x, desc_a, info, jx,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cnrm2 @@ -196,7 +196,7 @@ function psb_cnrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -211,9 +211,9 @@ function psb_cnrm2v(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -256,12 +256,12 @@ function psb_cnrm2v(x, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cnrm2v @@ -293,7 +293,7 @@ function psb_cnrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -308,9 +308,9 @@ function psb_cnrm2_vect(x, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -363,12 +363,12 @@ function psb_cnrm2_vect(x, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cnrm2_vect @@ -401,7 +401,7 @@ function psb_cnrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -416,9 +416,9 @@ function psb_cnrm2_weight_vect(x,w, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -471,12 +471,12 @@ function psb_cnrm2_weight_vect(x,w, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cnrm2_weight_vect @@ -512,7 +512,7 @@ function psb_cnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -527,9 +527,9 @@ function psb_cnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -582,12 +582,12 @@ function psb_cnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cnrm2_weightmask_vect @@ -650,7 +650,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -665,9 +665,9 @@ subroutine psb_cnrm2vs(res, x, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -712,13 +712,13 @@ subroutine psb_cnrm2vs(res, x, desc_a, info,global) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cnrm2vs diff --git a/base/psblas/psb_cnrmi.f90 b/base/psblas/psb_cnrmi.f90 index 1303e5d8..f28719ea 100644 --- a/base/psblas/psb_cnrmi.f90 +++ b/base/psblas/psb_cnrmi.f90 @@ -53,7 +53,7 @@ function psb_cnrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja @@ -67,9 +67,9 @@ function psb_cnrmi(a,desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,12 +114,12 @@ function psb_cnrmi(a,desc_a,info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cnrmi diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index b35aa4af..fd8a9c39 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -71,7 +71,7 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx @@ -93,8 +93,8 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -251,12 +251,12 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cspmv_vect @@ -310,7 +310,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik @@ -332,9 +332,9 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -583,7 +583,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cspmm @@ -658,7 +658,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik @@ -680,8 +680,8 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -889,12 +889,12 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cspmv diff --git a/base/psblas/psb_cspnrm1.f90 b/base/psblas/psb_cspnrm1.f90 index 22e5f8a4..92b04ebb 100644 --- a/base/psblas/psb_cspnrm1.f90 +++ b/base/psblas/psb_cspnrm1.f90 @@ -53,7 +53,7 @@ function psb_cspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -66,9 +66,9 @@ function psb_cspnrm1(a,desc_a,info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -130,12 +130,12 @@ function psb_cspnrm1(a,desc_a,info,global) result(res) res = szero end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_cspnrm1 diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 0c0b4b4b..da99b8e9 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -84,7 +84,7 @@ subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& @@ -104,9 +104,9 @@ subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -224,7 +224,7 @@ subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cspsv_vect @@ -290,7 +290,7 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -310,9 +310,9 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -478,7 +478,7 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cspsm @@ -535,7 +535,7 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -555,9 +555,9 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -708,7 +708,7 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cspsv diff --git a/base/psblas/psb_cvmlt.f90 b/base/psblas/psb_cvmlt.f90 index 829ce987..a5ee7bbc 100644 --- a/base/psblas/psb_cvmlt.f90 +++ b/base/psblas/psb_cvmlt.f90 @@ -40,7 +40,7 @@ subroutine psb_cvmlt(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + integer(psb_ipk_) :: ctxt, np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -50,9 +50,9 @@ subroutine psb_cvmlt(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -104,7 +104,7 @@ subroutine psb_cvmlt(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_dabs_vect.f90 b/base/psblas/psb_dabs_vect.f90 index e749adf1..0b655d9c 100644 --- a/base/psblas/psb_dabs_vect.f90 +++ b/base/psblas/psb_dabs_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_dabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_dabs_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_dabs_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 index 30fc025f..490d4ffe 100644 --- a/base/psblas/psb_damax.f90 +++ b/base/psblas/psb_damax.f90 @@ -57,7 +57,7 @@ function psb_damax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_damax(x,desc_a, info, jx,global) result(res) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -119,12 +119,12 @@ function psb_damax(x,desc_a, info, jx,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_damax @@ -186,7 +186,7 @@ function psb_damaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -201,9 +201,9 @@ function psb_damaxv (x,desc_a, info,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -244,12 +244,12 @@ function psb_damaxv (x,desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_damaxv @@ -282,7 +282,7 @@ function psb_damax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -296,9 +296,9 @@ function psb_damax_vect(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -343,12 +343,12 @@ function psb_damax_vect(x, desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_damaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -427,9 +427,9 @@ subroutine psb_damaxvs(res,x,desc_a, info,global) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -469,12 +469,12 @@ subroutine psb_damaxvs(res,x,desc_a, info,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_damaxvs @@ -536,7 +536,7 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -550,9 +550,9 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -598,12 +598,12 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res(1:k)) + if (global_) call psb_amx(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dmamaxs @@ -636,7 +636,7 @@ function psb_dmin_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -650,9 +650,9 @@ function psb_dmin_vect(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -697,12 +697,12 @@ function psb_dmin_vect(x, desc_a, info,global) result(res) end if ! compute global min - if (global_) call psb_min(ictxt, res) + if (global_) call psb_min(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 index f3e02141..ff4399de 100644 --- a/base/psblas/psb_dasum.f90 +++ b/base/psblas/psb_dasum.f90 @@ -57,7 +57,7 @@ function psb_dasum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_dasum (x,desc_a, info, jx,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -126,12 +126,12 @@ function psb_dasum (x,desc_a, info, jx,global) result(res) res = dzero end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dasum @@ -161,7 +161,7 @@ function psb_dasum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -176,9 +176,9 @@ function psb_dasum_vect(x, desc_a, info,global) result(res) call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -232,12 +232,12 @@ function psb_dasum_vect(x, desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -299,7 +299,7 @@ function psb_dasumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -313,9 +313,9 @@ function psb_dasumv(x,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -364,12 +364,12 @@ function psb_dasumv(x,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dasumv @@ -431,7 +431,7 @@ subroutine psb_dasumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -445,9 +445,9 @@ subroutine psb_dasumvs(res,x,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -496,12 +496,12 @@ subroutine psb_dasumvs(res,x,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt,res) + if (global_) call psb_sum(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dasumvs diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index 5206bec3..f2768789 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -59,7 +59,7 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -70,9 +70,9 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -193,7 +193,7 @@ subroutine psb_daxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -204,9 +204,9 @@ subroutine psb_daxpby_vect_out(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -271,7 +271,7 @@ subroutine psb_daxpby_vect_out(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -310,7 +310,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) real(psb_dpk_), intent(inout) :: y(:,:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -323,8 +323,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -393,7 +393,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_daxpby @@ -459,7 +459,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) real(psb_dpk_), intent(inout) :: y(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -473,9 +473,9 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -518,7 +518,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_daxpbyv @@ -582,7 +582,7 @@ subroutine psb_daxpbyvout(alpha, x, beta,y, z, desc_a,info) real(psb_dpk_), intent(inout) :: z(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -596,9 +596,9 @@ subroutine psb_daxpbyvout(alpha, x, beta,y, z, desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -650,7 +650,7 @@ subroutine psb_daxpbyvout(alpha, x, beta,y, z, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_daxpbyvout @@ -678,7 +678,7 @@ subroutine psb_daddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -689,9 +689,9 @@ subroutine psb_daddconst_vect(x,b,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -736,7 +736,7 @@ subroutine psb_daddconst_vect(x,b,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_dcmp_vect.f90 b/base/psblas/psb_dcmp_vect.f90 index eb426a10..b52b34d1 100644 --- a/base/psblas/psb_dcmp_vect.f90 +++ b/base/psblas/psb_dcmp_vect.f90 @@ -41,7 +41,7 @@ subroutine psb_dcmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -52,9 +52,9 @@ subroutine psb_dcmp_vect(x,c,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_dcmp_vect(x,c,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -149,7 +149,7 @@ subroutine psb_dmask_vect(c,x,m,t,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, mm @@ -160,9 +160,9 @@ subroutine psb_dmask_vect(c,x,m,t,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -216,12 +216,12 @@ subroutine psb_dmask_vect(c,x,m,t,desc_a,info) call m%mask(c,x,t,info) end if - call psb_lallreduceand(ictxt,t) + call psb_lallreduceand(ctxt,t) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -239,7 +239,7 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -254,8 +254,8 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,16 +269,16 @@ subroutine psb_dcmp_spmatval(a,val,tol,desc_a,res,info) res = a%spcmp(val,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dcmp_spmatval @@ -294,7 +294,7 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -309,8 +309,8 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -326,17 +326,17 @@ subroutine psb_dcmp_spmat(a,b,tol,desc_a,res,info) res = a%spcmp(b,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_ddiv_vect.f90 b/base/psblas/psb_ddiv_vect.f90 index ba57776b..7f958e19 100644 --- a/base/psblas/psb_ddiv_vect.f90 +++ b/base/psblas/psb_ddiv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_ddiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_ddiv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_ddiv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -115,7 +115,7 @@ subroutine psb_ddiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -126,9 +126,9 @@ subroutine psb_ddiv_vect2(x,y,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -187,7 +187,7 @@ subroutine psb_ddiv_vect2(x,y,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -203,7 +203,7 @@ subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -214,9 +214,9 @@ subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -262,7 +262,7 @@ subroutine psb_ddiv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -279,7 +279,7 @@ subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -290,9 +290,9 @@ subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -350,7 +350,7 @@ subroutine psb_ddiv_vect2_check(x,y,z,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -373,7 +373,7 @@ function psb_dminquotient_vect(x,y,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -387,9 +387,9 @@ function psb_dminquotient_vect(x,y,desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -434,12 +434,12 @@ function psb_dminquotient_vect(x,y,desc_a,info,global) result(res) end if ! compute global min - if (global_) call psb_min(ictxt, res) + if (global_) call psb_min(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index 65474433..633c7549 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -64,7 +64,7 @@ function psb_ddot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -79,8 +79,8 @@ function psb_ddot_vect(x, y, desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -147,12 +147,12 @@ function psb_ddot_vect(x, y, desc_a,info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -188,7 +188,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -203,8 +203,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -272,12 +272,12 @@ function psb_ddot(x, y,desc_a, info, jx, jy,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_ddot @@ -340,7 +340,7 @@ function psb_ddotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -355,9 +355,9 @@ function psb_ddotv(x, y,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -408,13 +408,13 @@ function psb_ddotv(x, y,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_ddotv @@ -477,7 +477,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -492,9 +492,9 @@ subroutine psb_ddotvs(res, x, y,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -543,12 +543,12 @@ subroutine psb_ddotvs(res, x, y,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ddotvs @@ -612,7 +612,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -627,9 +627,9 @@ subroutine psb_dmdots(res, x, y, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -690,12 +690,12 @@ subroutine psb_dmdots(res, x, y, desc_a, info,global) ! compute global sum - if (global_) call psb_sum(ictxt, res(1:k)) + if (global_) call psb_sum(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dmdots diff --git a/base/psblas/psb_dgetmatinfo.f90 b/base/psblas/psb_dgetmatinfo.f90 index f27acbd3..51ef5ca8 100644 --- a/base/psblas/psb_dgetmatinfo.f90 +++ b/base/psblas/psb_dgetmatinfo.f90 @@ -47,7 +47,7 @@ function psb_dget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz @@ -60,8 +60,8 @@ function psb_dget_nnz(a,desc_a,info) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -70,12 +70,12 @@ function psb_dget_nnz(a,desc_a,info) result(res) localnnz = a%get_nzeros() - call psb_sum(ictxt,localnnz) + call psb_sum(ctxt,localnnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function diff --git a/base/psblas/psb_dinv_vect.f90 b/base/psblas/psb_dinv_vect.f90 index a4ef6ecc..2159398f 100644 --- a/base/psblas/psb_dinv_vect.f90 +++ b/base/psblas/psb_dinv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_dinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_dinv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_dinv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -116,7 +116,7 @@ subroutine psb_dinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -127,9 +127,9 @@ subroutine psb_dinv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -178,7 +178,7 @@ subroutine psb_dinv_vect_check(x,y,desc_a,info,flag) check = .TRUE. end if - call psb_lallreduceand(ictxt,check) + call psb_lallreduceand(ctxt,check) if (check) then info = 1_psb_ipk_ @@ -189,7 +189,7 @@ subroutine psb_dinv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_dmlt_vect.f90 b/base/psblas/psb_dmlt_vect.f90 index 72754d11..80a138c1 100644 --- a/base/psblas/psb_dmlt_vect.f90 +++ b/base/psblas/psb_dmlt_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_dmlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_dmlt_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_dmlt_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -121,7 +121,7 @@ subroutine psb_dmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -132,9 +132,9 @@ subroutine psb_dmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_dmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 index 2afd6982..423bebe2 100644 --- a/base/psblas/psb_dnrm2.f90 +++ b/base/psblas/psb_dnrm2.f90 @@ -60,7 +60,7 @@ function psb_dnrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -75,9 +75,9 @@ function psb_dnrm2(x, desc_a, info, jx,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -127,12 +127,12 @@ function psb_dnrm2(x, desc_a, info, jx,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dnrm2 @@ -196,7 +196,7 @@ function psb_dnrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -211,9 +211,9 @@ function psb_dnrm2v(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -256,12 +256,12 @@ function psb_dnrm2v(x, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dnrm2v @@ -293,7 +293,7 @@ function psb_dnrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -308,9 +308,9 @@ function psb_dnrm2_vect(x, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -363,12 +363,12 @@ function psb_dnrm2_vect(x, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dnrm2_vect @@ -401,7 +401,7 @@ function psb_dnrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -416,9 +416,9 @@ function psb_dnrm2_weight_vect(x,w, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -471,12 +471,12 @@ function psb_dnrm2_weight_vect(x,w, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dnrm2_weight_vect @@ -512,7 +512,7 @@ function psb_dnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -527,9 +527,9 @@ function psb_dnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -582,12 +582,12 @@ function psb_dnrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dnrm2_weightmask_vect @@ -650,7 +650,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -665,9 +665,9 @@ subroutine psb_dnrm2vs(res, x, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -712,13 +712,13 @@ subroutine psb_dnrm2vs(res, x, desc_a, info,global) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dnrm2vs diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index 2d67fb7c..e06bc71b 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -53,7 +53,7 @@ function psb_dnrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja @@ -67,9 +67,9 @@ function psb_dnrmi(a,desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,12 +114,12 @@ function psb_dnrmi(a,desc_a,info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dnrmi diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index ab733692..a006c7e9 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -71,7 +71,7 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx @@ -93,8 +93,8 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -251,12 +251,12 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dspmv_vect @@ -310,7 +310,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik @@ -332,9 +332,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -583,7 +583,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dspmm @@ -658,7 +658,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik @@ -680,8 +680,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -889,12 +889,12 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dspmv diff --git a/base/psblas/psb_dspnrm1.f90 b/base/psblas/psb_dspnrm1.f90 index 1e118a35..6bdb4eea 100644 --- a/base/psblas/psb_dspnrm1.f90 +++ b/base/psblas/psb_dspnrm1.f90 @@ -53,7 +53,7 @@ function psb_dspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -66,9 +66,9 @@ function psb_dspnrm1(a,desc_a,info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -130,12 +130,12 @@ function psb_dspnrm1(a,desc_a,info,global) result(res) res = dzero end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_dspnrm1 diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index 2c5d4807..9e5eeafc 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -84,7 +84,7 @@ subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& @@ -104,9 +104,9 @@ subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -224,7 +224,7 @@ subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dspsv_vect @@ -290,7 +290,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -310,9 +310,9 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -478,7 +478,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dspsm @@ -535,7 +535,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -555,9 +555,9 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -708,7 +708,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_dspsv diff --git a/base/psblas/psb_dvmlt.f90 b/base/psblas/psb_dvmlt.f90 index ec5325fc..ea76e57a 100644 --- a/base/psblas/psb_dvmlt.f90 +++ b/base/psblas/psb_dvmlt.f90 @@ -40,7 +40,7 @@ subroutine psb_dvmlt(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + integer(psb_ipk_) :: ctxt, np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -50,9 +50,9 @@ subroutine psb_dvmlt(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -104,7 +104,7 @@ subroutine psb_dvmlt(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_sabs_vect.f90 b/base/psblas/psb_sabs_vect.f90 index 9d88b526..2eb22d73 100644 --- a/base/psblas/psb_sabs_vect.f90 +++ b/base/psblas/psb_sabs_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_sabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_sabs_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_sabs_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_samax.f90 b/base/psblas/psb_samax.f90 index 08d921d3..b2858d96 100644 --- a/base/psblas/psb_samax.f90 +++ b/base/psblas/psb_samax.f90 @@ -57,7 +57,7 @@ function psb_samax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_samax(x,desc_a, info, jx,global) result(res) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -119,12 +119,12 @@ function psb_samax(x,desc_a, info, jx,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_samax @@ -186,7 +186,7 @@ function psb_samaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -201,9 +201,9 @@ function psb_samaxv (x,desc_a, info,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -244,12 +244,12 @@ function psb_samaxv (x,desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_samaxv @@ -282,7 +282,7 @@ function psb_samax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -296,9 +296,9 @@ function psb_samax_vect(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -343,12 +343,12 @@ function psb_samax_vect(x, desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_samaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -427,9 +427,9 @@ subroutine psb_samaxvs(res,x,desc_a, info,global) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -469,12 +469,12 @@ subroutine psb_samaxvs(res,x,desc_a, info,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_samaxvs @@ -536,7 +536,7 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -550,9 +550,9 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -598,12 +598,12 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res(1:k)) + if (global_) call psb_amx(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_smamaxs @@ -636,7 +636,7 @@ function psb_smin_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -650,9 +650,9 @@ function psb_smin_vect(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -697,12 +697,12 @@ function psb_smin_vect(x, desc_a, info,global) result(res) end if ! compute global min - if (global_) call psb_min(ictxt, res) + if (global_) call psb_min(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_sasum.f90 b/base/psblas/psb_sasum.f90 index 406b8e8e..6ca62d24 100644 --- a/base/psblas/psb_sasum.f90 +++ b/base/psblas/psb_sasum.f90 @@ -57,7 +57,7 @@ function psb_sasum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_sasum (x,desc_a, info, jx,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -126,12 +126,12 @@ function psb_sasum (x,desc_a, info, jx,global) result(res) res = szero end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_sasum @@ -161,7 +161,7 @@ function psb_sasum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -176,9 +176,9 @@ function psb_sasum_vect(x, desc_a, info,global) result(res) call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -232,12 +232,12 @@ function psb_sasum_vect(x, desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -299,7 +299,7 @@ function psb_sasumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -313,9 +313,9 @@ function psb_sasumv(x,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -364,12 +364,12 @@ function psb_sasumv(x,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_sasumv @@ -431,7 +431,7 @@ subroutine psb_sasumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -445,9 +445,9 @@ subroutine psb_sasumvs(res,x,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -496,12 +496,12 @@ subroutine psb_sasumvs(res,x,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt,res) + if (global_) call psb_sum(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sasumvs diff --git a/base/psblas/psb_saxpby.f90 b/base/psblas/psb_saxpby.f90 index a04b622e..774c1ad7 100644 --- a/base/psblas/psb_saxpby.f90 +++ b/base/psblas/psb_saxpby.f90 @@ -59,7 +59,7 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -70,9 +70,9 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -193,7 +193,7 @@ subroutine psb_saxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -204,9 +204,9 @@ subroutine psb_saxpby_vect_out(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -271,7 +271,7 @@ subroutine psb_saxpby_vect_out(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -310,7 +310,7 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) real(psb_spk_), intent(inout) :: y(:,:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -323,8 +323,8 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -393,7 +393,7 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_saxpby @@ -459,7 +459,7 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info) real(psb_spk_), intent(inout) :: y(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -473,9 +473,9 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -518,7 +518,7 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_saxpbyv @@ -582,7 +582,7 @@ subroutine psb_saxpbyvout(alpha, x, beta,y, z, desc_a,info) real(psb_spk_), intent(inout) :: z(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -596,9 +596,9 @@ subroutine psb_saxpbyvout(alpha, x, beta,y, z, desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -650,7 +650,7 @@ subroutine psb_saxpbyvout(alpha, x, beta,y, z, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_saxpbyvout @@ -678,7 +678,7 @@ subroutine psb_saddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -689,9 +689,9 @@ subroutine psb_saddconst_vect(x,b,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -736,7 +736,7 @@ subroutine psb_saddconst_vect(x,b,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_scmp_vect.f90 b/base/psblas/psb_scmp_vect.f90 index 7a32dd6e..7a7ff002 100644 --- a/base/psblas/psb_scmp_vect.f90 +++ b/base/psblas/psb_scmp_vect.f90 @@ -41,7 +41,7 @@ subroutine psb_scmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -52,9 +52,9 @@ subroutine psb_scmp_vect(x,c,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_scmp_vect(x,c,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -149,7 +149,7 @@ subroutine psb_smask_vect(c,x,m,t,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, mm @@ -160,9 +160,9 @@ subroutine psb_smask_vect(c,x,m,t,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -216,12 +216,12 @@ subroutine psb_smask_vect(c,x,m,t,desc_a,info) call m%mask(c,x,t,info) end if - call psb_lallreduceand(ictxt,t) + call psb_lallreduceand(ctxt,t) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -239,7 +239,7 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -254,8 +254,8 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,16 +269,16 @@ subroutine psb_scmp_spmatval(a,val,tol,desc_a,res,info) res = a%spcmp(val,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_scmp_spmatval @@ -294,7 +294,7 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -309,8 +309,8 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -326,17 +326,17 @@ subroutine psb_scmp_spmat(a,b,tol,desc_a,res,info) res = a%spcmp(b,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_sdiv_vect.f90 b/base/psblas/psb_sdiv_vect.f90 index 1857200c..70bb96d0 100644 --- a/base/psblas/psb_sdiv_vect.f90 +++ b/base/psblas/psb_sdiv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_sdiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_sdiv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_sdiv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -115,7 +115,7 @@ subroutine psb_sdiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -126,9 +126,9 @@ subroutine psb_sdiv_vect2(x,y,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -187,7 +187,7 @@ subroutine psb_sdiv_vect2(x,y,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -203,7 +203,7 @@ subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -214,9 +214,9 @@ subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -262,7 +262,7 @@ subroutine psb_sdiv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -279,7 +279,7 @@ subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -290,9 +290,9 @@ subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -350,7 +350,7 @@ subroutine psb_sdiv_vect2_check(x,y,z,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -373,7 +373,7 @@ function psb_sminquotient_vect(x,y,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -387,9 +387,9 @@ function psb_sminquotient_vect(x,y,desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -434,12 +434,12 @@ function psb_sminquotient_vect(x,y,desc_a,info,global) result(res) end if ! compute global min - if (global_) call psb_min(ictxt, res) + if (global_) call psb_min(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_sdot.f90 b/base/psblas/psb_sdot.f90 index dbc1a17e..cf0678a7 100644 --- a/base/psblas/psb_sdot.f90 +++ b/base/psblas/psb_sdot.f90 @@ -64,7 +64,7 @@ function psb_sdot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -79,8 +79,8 @@ function psb_sdot_vect(x, y, desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -147,12 +147,12 @@ function psb_sdot_vect(x, y, desc_a,info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -188,7 +188,7 @@ function psb_sdot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -203,8 +203,8 @@ function psb_sdot(x, y,desc_a, info, jx, jy,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -272,12 +272,12 @@ function psb_sdot(x, y,desc_a, info, jx, jy,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_sdot @@ -340,7 +340,7 @@ function psb_sdotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -355,9 +355,9 @@ function psb_sdotv(x, y,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -408,13 +408,13 @@ function psb_sdotv(x, y,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_sdotv @@ -477,7 +477,7 @@ subroutine psb_sdotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -492,9 +492,9 @@ subroutine psb_sdotvs(res, x, y,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -543,12 +543,12 @@ subroutine psb_sdotvs(res, x, y,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sdotvs @@ -612,7 +612,7 @@ subroutine psb_smdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -627,9 +627,9 @@ subroutine psb_smdots(res, x, y, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -690,12 +690,12 @@ subroutine psb_smdots(res, x, y, desc_a, info,global) ! compute global sum - if (global_) call psb_sum(ictxt, res(1:k)) + if (global_) call psb_sum(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_smdots diff --git a/base/psblas/psb_sgetmatinfo.f90 b/base/psblas/psb_sgetmatinfo.f90 index 7e10aee1..2da00f27 100644 --- a/base/psblas/psb_sgetmatinfo.f90 +++ b/base/psblas/psb_sgetmatinfo.f90 @@ -47,7 +47,7 @@ function psb_sget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz @@ -60,8 +60,8 @@ function psb_sget_nnz(a,desc_a,info) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -70,12 +70,12 @@ function psb_sget_nnz(a,desc_a,info) result(res) localnnz = a%get_nzeros() - call psb_sum(ictxt,localnnz) + call psb_sum(ctxt,localnnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function diff --git a/base/psblas/psb_sinv_vect.f90 b/base/psblas/psb_sinv_vect.f90 index c3e3e891..f658b177 100644 --- a/base/psblas/psb_sinv_vect.f90 +++ b/base/psblas/psb_sinv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_sinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_sinv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_sinv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -116,7 +116,7 @@ subroutine psb_sinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -127,9 +127,9 @@ subroutine psb_sinv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -178,7 +178,7 @@ subroutine psb_sinv_vect_check(x,y,desc_a,info,flag) check = .TRUE. end if - call psb_lallreduceand(ictxt,check) + call psb_lallreduceand(ctxt,check) if (check) then info = 1_psb_ipk_ @@ -189,7 +189,7 @@ subroutine psb_sinv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_smlt_vect.f90 b/base/psblas/psb_smlt_vect.f90 index 30722022..04b3150c 100644 --- a/base/psblas/psb_smlt_vect.f90 +++ b/base/psblas/psb_smlt_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_smlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_smlt_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_smlt_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -121,7 +121,7 @@ subroutine psb_smlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -132,9 +132,9 @@ subroutine psb_smlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_smlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_snrm2.f90 b/base/psblas/psb_snrm2.f90 index fbf1bdd5..2211224b 100644 --- a/base/psblas/psb_snrm2.f90 +++ b/base/psblas/psb_snrm2.f90 @@ -60,7 +60,7 @@ function psb_snrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -75,9 +75,9 @@ function psb_snrm2(x, desc_a, info, jx,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -127,12 +127,12 @@ function psb_snrm2(x, desc_a, info, jx,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_snrm2 @@ -196,7 +196,7 @@ function psb_snrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -211,9 +211,9 @@ function psb_snrm2v(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -256,12 +256,12 @@ function psb_snrm2v(x, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_snrm2v @@ -293,7 +293,7 @@ function psb_snrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -308,9 +308,9 @@ function psb_snrm2_vect(x, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -363,12 +363,12 @@ function psb_snrm2_vect(x, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_snrm2_vect @@ -401,7 +401,7 @@ function psb_snrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -416,9 +416,9 @@ function psb_snrm2_weight_vect(x,w, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -471,12 +471,12 @@ function psb_snrm2_weight_vect(x,w, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_snrm2_weight_vect @@ -512,7 +512,7 @@ function psb_snrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -527,9 +527,9 @@ function psb_snrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -582,12 +582,12 @@ function psb_snrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_snrm2_weightmask_vect @@ -650,7 +650,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -665,9 +665,9 @@ subroutine psb_snrm2vs(res, x, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -712,13 +712,13 @@ subroutine psb_snrm2vs(res, x, desc_a, info,global) res = szero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_snrm2vs diff --git a/base/psblas/psb_snrmi.f90 b/base/psblas/psb_snrmi.f90 index 2234474c..d48bb5f9 100644 --- a/base/psblas/psb_snrmi.f90 +++ b/base/psblas/psb_snrmi.f90 @@ -53,7 +53,7 @@ function psb_snrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja @@ -67,9 +67,9 @@ function psb_snrmi(a,desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,12 +114,12 @@ function psb_snrmi(a,desc_a,info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_snrmi diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index 769450e7..43ee0d48 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -71,7 +71,7 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx @@ -93,8 +93,8 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -251,12 +251,12 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sspmv_vect @@ -310,7 +310,7 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik @@ -332,9 +332,9 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -583,7 +583,7 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sspmm @@ -658,7 +658,7 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik @@ -680,8 +680,8 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -889,12 +889,12 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sspmv diff --git a/base/psblas/psb_sspnrm1.f90 b/base/psblas/psb_sspnrm1.f90 index 71b540bf..09ea96fb 100644 --- a/base/psblas/psb_sspnrm1.f90 +++ b/base/psblas/psb_sspnrm1.f90 @@ -53,7 +53,7 @@ function psb_sspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -66,9 +66,9 @@ function psb_sspnrm1(a,desc_a,info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -130,12 +130,12 @@ function psb_sspnrm1(a,desc_a,info,global) result(res) res = szero end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_sspnrm1 diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index d9371624..522d4bd9 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -84,7 +84,7 @@ subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& @@ -104,9 +104,9 @@ subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -224,7 +224,7 @@ subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sspsv_vect @@ -290,7 +290,7 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -310,9 +310,9 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -478,7 +478,7 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sspsm @@ -535,7 +535,7 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -555,9 +555,9 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -708,7 +708,7 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_sspsv diff --git a/base/psblas/psb_svmlt.f90 b/base/psblas/psb_svmlt.f90 index cfe09de1..a9b506c6 100644 --- a/base/psblas/psb_svmlt.f90 +++ b/base/psblas/psb_svmlt.f90 @@ -40,7 +40,7 @@ subroutine psb_svmlt(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + integer(psb_ipk_) :: ctxt, np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -50,9 +50,9 @@ subroutine psb_svmlt(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -104,7 +104,7 @@ subroutine psb_svmlt(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_zabs_vect.f90 b/base/psblas/psb_zabs_vect.f90 index fe1a1f7f..8c027727 100644 --- a/base/psblas/psb_zabs_vect.f90 +++ b/base/psblas/psb_zabs_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_zabs_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_zabs_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_zabs_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 index 035697da..79cc6d96 100644 --- a/base/psblas/psb_zamax.f90 +++ b/base/psblas/psb_zamax.f90 @@ -57,7 +57,7 @@ function psb_zamax(x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_zamax(x,desc_a, info, jx,global) result(res) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -119,12 +119,12 @@ function psb_zamax(x,desc_a, info, jx,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zamax @@ -186,7 +186,7 @@ function psb_zamaxv (x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -201,9 +201,9 @@ function psb_zamaxv (x,desc_a, info,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -244,12 +244,12 @@ function psb_zamaxv (x,desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zamaxv @@ -282,7 +282,7 @@ function psb_zamax_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -296,9 +296,9 @@ function psb_zamax_vect(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -343,12 +343,12 @@ function psb_zamax_vect(x, desc_a, info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_zamaxvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -427,9 +427,9 @@ subroutine psb_zamaxvs(res,x,desc_a, info,global) end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -469,12 +469,12 @@ subroutine psb_zamaxvs(res,x,desc_a, info,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zamaxvs @@ -536,7 +536,7 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ldx, i, k integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -550,9 +550,9 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -598,12 +598,12 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx,global) end if ! compute global max - if (global_) call psb_amx(ictxt, res(1:k)) + if (global_) call psb_amx(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zmamaxs diff --git a/base/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 index 6ede26d8..63061d0b 100644 --- a/base/psblas/psb_zasum.f90 +++ b/base/psblas/psb_zasum.f90 @@ -57,7 +57,7 @@ function psb_zasum (x,desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -72,9 +72,9 @@ function psb_zasum (x,desc_a, info, jx,global) result(res) end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -126,12 +126,12 @@ function psb_zasum (x,desc_a, info, jx,global) result(res) res = dzero end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zasum @@ -161,7 +161,7 @@ function psb_zasum_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, imax, i, idx, ndm integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -176,9 +176,9 @@ function psb_zasum_vect(x, desc_a, info,global) result(res) call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -232,12 +232,12 @@ function psb_zasum_vect(x, desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -299,7 +299,7 @@ function psb_zasumv(x,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -313,9 +313,9 @@ function psb_zasumv(x,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -364,12 +364,12 @@ function psb_zasumv(x,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zasumv @@ -431,7 +431,7 @@ subroutine psb_zasumvs(res,x,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, i, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -445,9 +445,9 @@ subroutine psb_zasumvs(res,x,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -496,12 +496,12 @@ subroutine psb_zasumvs(res,x,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt,res) + if (global_) call psb_sum(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zasumvs diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index ce96a080..1165ea8a 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -59,7 +59,7 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -70,9 +70,9 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -124,7 +124,7 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -193,7 +193,7 @@ subroutine psb_zaxpby_vect_out(alpha, x, beta, y,& integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -204,9 +204,9 @@ subroutine psb_zaxpby_vect_out(alpha, x, beta, y,& info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -271,7 +271,7 @@ subroutine psb_zaxpby_vect_out(alpha, x, beta, y,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -310,7 +310,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) complex(psb_dpk_), intent(inout) :: y(:,:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, in, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -323,8 +323,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -393,7 +393,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zaxpby @@ -459,7 +459,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) complex(psb_dpk_), intent(inout) :: y(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -473,9 +473,9 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -518,7 +518,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zaxpbyv @@ -582,7 +582,7 @@ subroutine psb_zaxpbyvout(alpha, x, beta,y, z, desc_a,info) complex(psb_dpk_), intent(inout) :: z(:) ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz, lldx, lldy, lldz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -596,9 +596,9 @@ subroutine psb_zaxpbyvout(alpha, x, beta,y, z, desc_a,info) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -650,7 +650,7 @@ subroutine psb_zaxpbyvout(alpha, x, beta,y, z, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zaxpbyvout @@ -678,7 +678,7 @@ subroutine psb_zaddconst_vect(x,b,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -689,9 +689,9 @@ subroutine psb_zaddconst_vect(x,b,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -736,7 +736,7 @@ subroutine psb_zaddconst_vect(x,b,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_zcmp_vect.f90 b/base/psblas/psb_zcmp_vect.f90 index 2e6d65d1..01e1cecf 100644 --- a/base/psblas/psb_zcmp_vect.f90 +++ b/base/psblas/psb_zcmp_vect.f90 @@ -41,7 +41,7 @@ subroutine psb_zcmp_vect(x,c,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -52,9 +52,9 @@ subroutine psb_zcmp_vect(x,c,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_zcmp_vect(x,c,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -116,7 +116,7 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -131,8 +131,8 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,16 +146,16 @@ subroutine psb_zcmp_spmatval(a,val,tol,desc_a,res,info) res = a%spcmp(val,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zcmp_spmatval @@ -171,7 +171,7 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info) logical, intent(out) :: res ! Local - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: err_act character(len=20) :: name, ch_err @@ -186,8 +186,8 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -203,17 +203,17 @@ subroutine psb_zcmp_spmat(a,b,tol,desc_a,res,info) res = a%spcmp(b,tol,info) end if - call psb_lallreduceand(ictxt,res) + call psb_lallreduceand(ctxt,res) call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_zdiv_vect.f90 b/base/psblas/psb_zdiv_vect.f90 index f6ef22ec..22d8b21c 100644 --- a/base/psblas/psb_zdiv_vect.f90 +++ b/base/psblas/psb_zdiv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_zdiv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_zdiv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_zdiv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -115,7 +115,7 @@ subroutine psb_zdiv_vect2(x,y,z,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -126,9 +126,9 @@ subroutine psb_zdiv_vect2(x,y,z,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -187,7 +187,7 @@ subroutine psb_zdiv_vect2(x,y,z,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -203,7 +203,7 @@ subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -214,9 +214,9 @@ subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -262,7 +262,7 @@ subroutine psb_zdiv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -279,7 +279,7 @@ subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag) logical, intent(in) :: flag ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -290,9 +290,9 @@ subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -350,7 +350,7 @@ subroutine psb_zdiv_vect2_check(x,y,z,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index 12a82696..97ecbedf 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -64,7 +64,7 @@ function psb_zdot_vect(x, y, desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -79,8 +79,8 @@ function psb_zdot_vect(x, y, desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -147,12 +147,12 @@ function psb_zdot_vect(x, y, desc_a,info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -188,7 +188,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -203,8 +203,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -272,12 +272,12 @@ function psb_zdot(x, y,desc_a, info, jx, jy,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zdot @@ -340,7 +340,7 @@ function psb_zdotv(x, y,desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -355,9 +355,9 @@ function psb_zdotv(x, y,desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -408,13 +408,13 @@ function psb_zdotv(x, y,desc_a, info,global) result(res) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zdotv @@ -477,7 +477,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i,nr, lldx, lldy integer(psb_lpk_) :: ix, jx, iy, jy, m @@ -492,9 +492,9 @@ subroutine psb_zdotvs(res, x, y,desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -543,12 +543,12 @@ subroutine psb_zdotvs(res, x, y,desc_a, info,global) end if ! compute global sum - if (global_) call psb_sum(ictxt, res) + if (global_) call psb_sum(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zdotvs @@ -612,7 +612,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, idx, ndm,& & err_act, iix, jjx, iiy, jjy, i, j, k, nr, lldx, lldy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -627,9 +627,9 @@ subroutine psb_zmdots(res, x, y, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -690,12 +690,12 @@ subroutine psb_zmdots(res, x, y, desc_a, info,global) ! compute global sum - if (global_) call psb_sum(ictxt, res(1:k)) + if (global_) call psb_sum(ctxt, res(1:k)) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zmdots diff --git a/base/psblas/psb_zgetmatinfo.f90 b/base/psblas/psb_zgetmatinfo.f90 index c157613f..08482963 100644 --- a/base/psblas/psb_zgetmatinfo.f90 +++ b/base/psblas/psb_zgetmatinfo.f90 @@ -47,7 +47,7 @@ function psb_zget_nnz(a,desc_a,info) result(res) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja integer(psb_lpk_) :: localnnz @@ -60,8 +60,8 @@ function psb_zget_nnz(a,desc_a,info) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -70,12 +70,12 @@ function psb_zget_nnz(a,desc_a,info) result(res) localnnz = a%get_nzeros() - call psb_sum(ictxt,localnnz) + call psb_sum(ctxt,localnnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function diff --git a/base/psblas/psb_zinv_vect.f90 b/base/psblas/psb_zinv_vect.f90 index 938ec42e..593d342b 100644 --- a/base/psblas/psb_zinv_vect.f90 +++ b/base/psblas/psb_zinv_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_zinv_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_zinv_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_zinv_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -116,7 +116,7 @@ subroutine psb_zinv_vect_check(x,y,desc_a,info,flag) logical :: check ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -127,9 +127,9 @@ subroutine psb_zinv_vect_check(x,y,desc_a,info,flag) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -178,7 +178,7 @@ subroutine psb_zinv_vect_check(x,y,desc_a,info,flag) check = .TRUE. end if - call psb_lallreduceand(ictxt,check) + call psb_lallreduceand(ctxt,check) if (check) then info = 1_psb_ipk_ @@ -189,7 +189,7 @@ subroutine psb_zinv_vect_check(x,y,desc_a,info,flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_zmlt_vect.f90 b/base/psblas/psb_zmlt_vect.f90 index e35a3b5a..5db9cdb4 100644 --- a/base/psblas/psb_zmlt_vect.f90 +++ b/base/psblas/psb_zmlt_vect.f90 @@ -40,7 +40,7 @@ subroutine psb_zmlt_vect(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -51,9 +51,9 @@ subroutine psb_zmlt_vect(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -99,7 +99,7 @@ subroutine psb_zmlt_vect(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -121,7 +121,7 @@ subroutine psb_zmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) character(len=1), intent(in), optional :: conjgx, conjgy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iiy, jjy, iiz, jjz integer(psb_lpk_) :: ix, ijx, iy, ijy, iz, ijz, m @@ -132,9 +132,9 @@ subroutine psb_zmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_zmlt_vect2(alpha,x,y,beta,z,desc_a,info,conjgx, conjgy) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 index 2a616a8c..1ba0f9da 100644 --- a/base/psblas/psb_znrm2.f90 +++ b/base/psblas/psb_znrm2.f90 @@ -60,7 +60,7 @@ function psb_znrm2(x, desc_a, info, jx,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, ijx, iy, ijy, m @@ -75,9 +75,9 @@ function psb_znrm2(x, desc_a, info, jx,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -127,12 +127,12 @@ function psb_znrm2(x, desc_a, info, jx,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_znrm2 @@ -196,7 +196,7 @@ function psb_znrm2v(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -211,9 +211,9 @@ function psb_znrm2v(x, desc_a, info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -256,12 +256,12 @@ function psb_znrm2v(x, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_znrm2v @@ -293,7 +293,7 @@ function psb_znrm2_vect(x, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -308,9 +308,9 @@ function psb_znrm2_vect(x, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -363,12 +363,12 @@ function psb_znrm2_vect(x, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_znrm2_vect @@ -401,7 +401,7 @@ function psb_znrm2_weight_vect(x,w, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -416,9 +416,9 @@ function psb_znrm2_weight_vect(x,w, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -471,12 +471,12 @@ function psb_znrm2_weight_vect(x,w, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_znrm2_weight_vect @@ -512,7 +512,7 @@ function psb_znrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -527,9 +527,9 @@ function psb_znrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -582,12 +582,12 @@ function psb_znrm2_weightmask_vect(x,w,idv, desc_a, info,global) result(res) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_znrm2_weightmask_vect @@ -650,7 +650,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info,global) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, ndim, i, id, idx, ndm, ldx integer(psb_lpk_) :: ix, jx, iy, ijy, m @@ -665,9 +665,9 @@ subroutine psb_znrm2vs(res, x, desc_a, info,global) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info=psb_err_context_error_ call psb_errpush(info,name) @@ -712,13 +712,13 @@ subroutine psb_znrm2vs(res, x, desc_a, info,global) res = dzero end if - if (global_) call psb_nrm2(ictxt,res) + if (global_) call psb_nrm2(ctxt,res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_znrm2vs diff --git a/base/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 index d49ae9cd..9afae6e7 100644 --- a/base/psblas/psb_znrmi.f90 +++ b/base/psblas/psb_znrmi.f90 @@ -53,7 +53,7 @@ function psb_znrmi(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: m, n, ia, ja @@ -67,9 +67,9 @@ function psb_znrmi(a,desc_a,info,global) result(res) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -114,12 +114,12 @@ function psb_znrmi(a,desc_a,info,global) result(res) end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_znrmi diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index 8eeefe37..b58ca303 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -71,7 +71,7 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx @@ -93,8 +93,8 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -251,12 +251,12 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zspmv_vect @@ -310,7 +310,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, i, ib, ib1, ip, idx, ik @@ -332,9 +332,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -583,7 +583,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zspmm @@ -658,7 +658,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& logical, intent(in), optional :: doswap ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, nrow, ncol, lldx, lldy, & & liwork, iiy, jjy, ib, ip, idx, ik @@ -680,8 +680,8 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt=desc_a%get_context() + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -889,12 +889,12 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) if (debug_level >= psb_debug_comp_) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) write(debug_unit,*) me,' ',trim(name),' Returning ' endif return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zspmv diff --git a/base/psblas/psb_zspnrm1.f90 b/base/psblas/psb_zspnrm1.f90 index 578c8329..cb568ab8 100644 --- a/base/psblas/psb_zspnrm1.f90 +++ b/base/psblas/psb_zspnrm1.f90 @@ -53,7 +53,7 @@ function psb_zspnrm1(a,desc_a,info,global) result(res) logical, intent(in), optional :: global ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, nr,nc,& & err_act, iia, jja, mdim, ndim integer(psb_lpk_) :: ix, ijx, iy, ijy, m, n, ia, ja @@ -66,9 +66,9 @@ function psb_zspnrm1(a,desc_a,info,global) result(res) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -130,12 +130,12 @@ function psb_zspnrm1(a,desc_a,info,global) result(res) res = dzero end if ! compute global max - if (global_) call psb_amx(ictxt, res) + if (global_) call psb_amx(ctxt, res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end function psb_zspnrm1 diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index 6daca718..80fbfb56 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -84,7 +84,7 @@ subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& & ix, iy, ik, jx, jy, i, lld,& @@ -104,9 +104,9 @@ subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -224,7 +224,7 @@ subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zspsv_vect @@ -290,7 +290,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: k, jx, jy ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me,& & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -310,9 +310,9 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -478,7 +478,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zspsm @@ -535,7 +535,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& integer(psb_ipk_), intent(in), optional :: choice ! locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, & & err_act, iix, jjx, iia, jja, lldx,lldy, choice_,& & ik, i, lld, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm @@ -555,9 +555,9 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -708,7 +708,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_zspsv diff --git a/base/psblas/psb_zvmlt.f90 b/base/psblas/psb_zvmlt.f90 index 01a6fc68..a4c06fc4 100644 --- a/base/psblas/psb_zvmlt.f90 +++ b/base/psblas/psb_zvmlt.f90 @@ -40,7 +40,7 @@ subroutine psb_zvmlt(x,y,desc_a,info) integer(psb_ipk_), intent(out) :: info ! locals - integer(psb_ipk_) :: ictxt, np, me,& + integer(psb_ipk_) :: ctxt, np, me,& & err_act, iix, jjx, iiy, jjy integer(psb_lpk_) :: ix, ijx, iy, ijy, m character(len=20) :: name, ch_err @@ -50,9 +50,9 @@ subroutine psb_zvmlt(x,y,desc_a,info) info=psb_success_ call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -ione) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -104,7 +104,7 @@ subroutine psb_zvmlt(x,y,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/serial/psb_sgelp.f90 b/base/serial/psb_sgelp.f90 index 6cb6f6f1..73e46c71 100644 --- a/base/serial/psb_sgelp.f90 +++ b/base/serial/psb_sgelp.f90 @@ -51,7 +51,7 @@ subroutine psb_sgelp(trans,iperm,x,info) integer(psb_ipk_), intent(out) :: info character, intent(in) :: trans ! local variables - integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: ctxt real(psb_spk_),allocatable :: temp(:) integer(psb_ipk_) :: int_err(5), i1sz, i2sz, err_act,i,j integer(psb_ipk_), allocatable :: itemp(:) @@ -178,7 +178,7 @@ subroutine psb_sgelpv(trans,iperm,x,info) character, intent(in) :: trans ! local variables - integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: ctxt integer(psb_ipk_) :: int_err(5), i1sz, err_act, i real(psb_spk_),allocatable :: temp(:) integer(psb_ipk_), allocatable :: itemp(:) diff --git a/base/tools/psb_c_glob_transpose.F90 b/base/tools/psb_c_glob_transpose.F90 index aa342bdb..4f6804fc 100644 --- a/base/tools/psb_c_glob_transpose.F90 +++ b/base/tools/psb_c_glob_transpose.F90 @@ -110,7 +110,7 @@ subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -138,10 +138,10 @@ subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -288,14 +288,14 @@ subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& @@ -386,7 +386,7 @@ subroutine psb_lc_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_lc_coo_glob_transpose @@ -407,7 +407,7 @@ subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -436,10 +436,10 @@ subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -588,14 +588,14 @@ subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + & iarcv(1:iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& @@ -692,7 +692,7 @@ subroutine psb_c_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_c_coo_glob_transpose @@ -711,20 +711,20 @@ subroutine psb_c_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_c_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -763,20 +763,20 @@ subroutine psb_c_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_c_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -815,20 +815,20 @@ subroutine psb_lc_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_lc_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -867,20 +867,20 @@ subroutine psb_lc_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_lc_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index be2d432c..2761205d 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -52,7 +52,7 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) complex(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -67,14 +67,14 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() + ctxt = map%p_desc_V%get_context() nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,x,czero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then @@ -84,7 +84,7 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() + ctxt = map%desc_V%get_context() nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -94,7 +94,7 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,xt,czero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then @@ -127,7 +127,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -142,8 +142,8 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_V%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then @@ -156,7 +156,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,x,czero,pty,info) if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) @@ -169,8 +169,8 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_V%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -190,7 +190,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(cone,map%mat_U2V,ptx,czero,pty,info) if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) @@ -235,7 +235,7 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) complex(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -250,14 +250,14 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() + ctxt = map%p_desc_U%get_context() nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,x,czero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then @@ -267,7 +267,7 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() + ctxt = map%desc_U%get_context() nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -277,7 +277,7 @@ subroutine psb_c_map_V2U_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,xt,czero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then @@ -309,7 +309,7 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ @@ -324,8 +324,8 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_U%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then @@ -338,7 +338,7 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,x,czero,pty,info) if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) @@ -351,8 +351,8 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_U%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -373,7 +373,7 @@ subroutine psb_c_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(cone,map%mat_V2U,ptx,czero,pty,info) if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) diff --git a/base/tools/psb_c_par_csr_spspmm.f90 b/base/tools/psb_c_par_csr_spspmm.f90 index a236254a..d5684b11 100644 --- a/base/tools/psb_c_par_csr_spspmm.f90 +++ b/base/tools/psb_c_par_csr_spspmm.f90 @@ -73,7 +73,7 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_lc_csr_sparse_mat) :: ltcsr @@ -92,9 +92,9 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -151,7 +151,7 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -169,7 +169,7 @@ Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_lc_csr_sparse_mat) :: tcsr1 @@ -187,9 +187,9 @@ Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -246,7 +246,7 @@ Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_callc.f90 b/base/tools/psb_callc.f90 index cbc189f0..530a43a2 100644 --- a/base/tools/psb_callc.f90 +++ b/base/tools/psb_callc.f90 @@ -52,7 +52,7 @@ subroutine psb_calloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -63,9 +63,9 @@ subroutine psb_calloc_vect(x, desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -105,7 +105,7 @@ subroutine psb_calloc_vect(x, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -133,7 +133,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -146,9 +146,9 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -177,9 +177,9 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -217,7 +217,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -236,7 +236,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -249,9 +249,9 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -275,9 +275,9 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -310,7 +310,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_callc_a.f90 b/base/tools/psb_callc_a.f90 index ffb5a6bb..5ae9dac5 100644 --- a/base/tools/psb_callc_a.f90 +++ b/base/tools/psb_callc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_calloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_calloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_calloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_calloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_callocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_callocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_callocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index 70649385..78d28f02 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -62,7 +62,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -74,13 +74,13 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) name = 'psb_cgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -118,7 +118,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -136,7 +136,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -148,13 +148,13 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch) name = 'psb_cgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -200,7 +200,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ @@ -232,7 +232,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) name = 'psb_cgeasb' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -249,7 +249,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) end if endif - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -289,7 +289,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_casb_a.f90 b/base/tools/psb_casb_a.f90 index 887cc7c9..db7b23c8 100644 --- a/base/tools/psb_casb_a.f90 +++ b/base/tools/psb_casb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_casb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_casb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_casb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_casb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_casbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_casbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_casbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index 02041a2a..a9ead509 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -90,7 +90,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_mpk_) :: icomm, minfo @@ -116,9 +116,9 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& @@ -189,7 +189,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_)then Write(debug_unit,*) me,' ',trim(name),& & ': BEGIN ',nhalo, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif ! ! Ok, since we are only estimating, do it as follows: @@ -217,7 +217,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_) then Write(debug_unit,*) me,' ',trim(name),':Start',& & lworks,lworkr, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif @@ -595,7 +595,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),':Done Crea_Index' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_move_alloc(t_halo_out,halo,info) ! @@ -674,7 +674,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),': converting indexes' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) @@ -703,7 +703,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 44950748..b12e845f 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -38,10 +38,10 @@ ! ! Arguments: ! v - integer(psb_ipk_), dimension(:). The array containg the partitioning scheme. -! ictxt - integer. The communication context. +! ctxt - integer. The communication context. ! desc - type(psb_desc_type). The communication descriptor. ! info - integer. Eventually returns an error code -subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) +subroutine psb_cd_inloc(v, ctxt, desc, info, globalcheck,idx,usehash) use psb_base_mod use psi_mod use psb_repl_map_mod @@ -49,7 +49,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) use psb_hash_map_mod implicit None !....Parameters... - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: v(:) integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc @@ -81,18 +81,18 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': start',np if (do_timings) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() end if loc_row = size(v) m = maxval(v) nrt = loc_row - call psb_sum(ictxt,nrt) - call psb_max(ictxt,m) + call psb_sum(ctxt,nrt) + call psb_max(ctxt,m) if (present(globalcheck)) then check_ = globalcheck @@ -126,9 +126,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) exch(1)=m exch(2)=n exch(3)=psb_cd_get_large_threshold() - call psb_bcast(ictxt,exch(1:3),root=psb_root_) + call psb_bcast(ctxt,exch(1:3),root=psb_root_) else - call psb_bcast(ictxt,exch(1:3),root=psb_root_) + call psb_bcast(ctxt,exch(1:3),root=psb_root_) if (exch(1) /= m) then err=550 l_err(1)=1 @@ -191,8 +191,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) end do if (info == psb_success_) then - call psb_amx(ictxt,tmpgidx(:,1)) - call psb_sum(ictxt,tmpgidx(:,2)) + call psb_amx(ctxt,tmpgidx(:,1)) + call psb_sum(ctxt,tmpgidx(:,2)) novrl = 0 npr_ov = 0 norphan = 0 @@ -236,7 +236,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) & write(debug_unit,*) me,' ',trim(name),': After global checks ' if (do_timings) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() end if @@ -276,7 +276,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_nullify_desc(desc) if (do_timings) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() end if @@ -307,7 +307,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) nov(me) = nov(me) + 1 end if end do - call psb_sum(ictxt,nov) + call psb_sum(ctxt,nov) nov(1:np) = nov(0:np-1) nov(0) = 1 do i=1, np @@ -329,7 +329,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_errpush(info,name,a_err='overlap count') goto 9999 end if - call psb_max(ictxt,ov_idx) + call psb_max(ctxt,ov_idx) call psb_msort(ov_idx(:,1),ix=ov_idx(:,2),flag=psb_sort_keep_idx_) end if @@ -388,7 +388,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) end do end if if (do_timings) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t3 = psb_wtime() end if if (debug_size) & @@ -406,9 +406,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(ictxt,m,info) + call aa%repl_map_init(ctxt,m,info) class default - call aa%init(ictxt,vl(1:nlu),info) + call aa%init(ctxt,vl(1:nlu),info) end select if (debug_size) & @@ -416,7 +416,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) if (do_timings) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t4 = psb_wtime() end if @@ -457,7 +457,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) endif if (do_timings) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) t5 = psb_wtime() t5 = t5 - t4 @@ -465,11 +465,11 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) t3 = t3 - t2 t2 = t2 - t1 t1 = t1 - t0 - call psb_amx(ictxt,t1) - call psb_amx(ictxt,t2) - call psb_amx(ictxt,t3) - call psb_amx(ictxt,t4) - call psb_amx(ictxt,t5) + call psb_amx(ctxt,t1) + call psb_amx(ctxt,t2) + call psb_amx(ctxt,t3) + call psb_amx(ctxt,t4) + call psb_amx(ctxt,t5) if (me==0) then write(0,*) 'CD_INLOC Timings: ' write(0,*) ' Phase 1 : ', t1 @@ -485,7 +485,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cd_lstext.f90 b/base/tools/psb_cd_lstext.f90 index 06d5c7e7..f96abd9c 100644 --- a/base/tools/psb_cd_lstext.f90 +++ b/base/tools/psb_cd_lstext.f90 @@ -45,7 +45,7 @@ Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) integer(psb_ipk_), intent(in),optional :: extype ! .. Local Scalars .. - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: i, j, np, me,m,nnzero,& & lovr, lworks,lworkr, n_row,n_col, int_err(5),& & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo @@ -71,8 +71,8 @@ Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),': start',size(in_list) @@ -134,7 +134,7 @@ Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),': converting indexes' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) @@ -154,7 +154,7 @@ Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cd_reinit.f90 b/base/tools/psb_cd_reinit.f90 index b33c6eef..d294cfc0 100644 --- a/base/tools/psb_cd_reinit.f90 +++ b/base/tools/psb_cd_reinit.f90 @@ -43,7 +43,7 @@ Subroutine psb_cd_reinit(desc,info) ! .. Local Scalars .. - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_mpk_) :: icomm integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ext(:), tmp_ovr(:) @@ -56,9 +56,9 @@ Subroutine psb_cd_reinit(desc,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() + ctxt = desc%get_context() icomm = desc%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start' if (desc%is_asb()) then @@ -82,7 +82,7 @@ Subroutine psb_cd_reinit(desc,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cd_renum_block.F90 b/base/tools/psb_cd_renum_block.F90 index 2b9203e2..e78e9079 100644 --- a/base/tools/psb_cd_renum_block.F90 +++ b/base/tools/psb_cd_renum_block.F90 @@ -55,7 +55,7 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) integer(psb_lpk_), allocatable :: gidx(:),vnl(:) integer(psb_ipk_) :: i, n_row, n_col integer(psb_lpk_) :: li, n_glob_row, n_glob_col - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -68,10 +68,10 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) call psb_erractionsave(err_act) name = 'psb_cd_renum_block' - ictxt = desc_in%get_context() + ctxt = desc_in%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': Entered' if (np == -1) then @@ -100,7 +100,7 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) n_glob_col = desc_in%get_global_cols() vnl = 0 vnl(me) = n_row - call psb_sum(ictxt,vnl) + call psb_sum(ctxt,vnl) vnl(1:np) = vnl(0:np-1) vnl(0) = 0 do i=1,np @@ -124,7 +124,7 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) reflidx(1:n_col) = [(i,i=1,n_col)] gidx(1:n_row) = reflidx(1:n_row) + vnl(me) call psb_halo(gidx,desc_in,info) - if (info == 0) call blck_map%gen_block_map_init(ictxt,n_row,info) + if (info == 0) call blck_map%gen_block_map_init(ctxt,n_row,info) if (info == 0) call blck_map%g2l_ins(gidx,lidx,info,lidx=reflidx) if (info == 0) call blck_map%asb(info) if (info == 0) call & @@ -149,7 +149,7 @@ subroutine psb_cd_renum_block(desc_in, desc_out, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cd_set_bld.f90 b/base/tools/psb_cd_set_bld.f90 index 71f6ac85..ecce17f9 100644 --- a/base/tools/psb_cd_set_bld.f90 +++ b/base/tools/psb_cd_set_bld.f90 @@ -53,7 +53,7 @@ subroutine psb_cd_set_bld(desc,info) type(psb_desc_type), intent(inout) :: desc integer(psb_ipk_) :: info !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act,idx,gidx,lidx,nc logical, parameter :: debug=.false.,debugprt=.false. character(len=20) :: name @@ -63,11 +63,11 @@ subroutine psb_cd_set_bld(desc,info) call psb_erractionsave(err_act) name = 'psb_cd_set_bld' - ictxt = desc%get_context() + ctxt = desc%get_context() if (debug) write(psb_err_unit,*)'Entered CDSETBLD' ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug) write(psb_err_unit,*) me,'Entered CDSETBLD' if (desc%is_asb()) call psb_cd_reinit(desc,info) @@ -78,7 +78,7 @@ subroutine psb_cd_set_bld(desc,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cd_switch_ovl_indxmap.f90 b/base/tools/psb_cd_switch_ovl_indxmap.f90 index 80eca15a..10ce794e 100644 --- a/base/tools/psb_cd_switch_ovl_indxmap.f90 +++ b/base/tools/psb_cd_switch_ovl_indxmap.f90 @@ -45,7 +45,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) integer(psb_ipk_), intent(out) :: info ! .. Local Scalars .. - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: i, j, np, me, n_row, n_col integer(psb_lpk_) :: mglob integer(psb_ipk_) :: err_act @@ -60,8 +60,8 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc%get_context() + Call psb_info(ctxt, me, np) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& @@ -91,14 +91,14 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) call desc%indxmap%free() deallocate(desc%indxmap) - if (psb_cd_choose_large_state(ictxt,mglob)) then + if (psb_cd_choose_large_state(ctxt,mglob)) then allocate(psb_hash_map :: desc%indxmap, stat=info) else allocate(psb_list_map :: desc%indxmap, stat=info) end if if (info == psb_success_)& - & call desc%indxmap%init(ictxt,vl(1:n_row),info) + & call desc%indxmap%init(ctxt,vl(1:n_row),info) if (info == psb_success_) call psb_cd_set_bld(desc,info) if (info == psb_success_) & & call desc%indxmap%g2lip_ins(vl(n_row+1:n_col),info) @@ -127,7 +127,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index 69cf82e4..e86eef0b 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -1,4 +1,4 @@ -subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& +subroutine psb_cdall(ctxt, desc, info,mg,ng,parts,& & vg,vl,flag,nl,repl,globalcheck,lidx,usehash) use psb_desc_mod use psb_serial_mod @@ -10,7 +10,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& implicit None procedure(psb_parts) :: parts integer(psb_lpk_), intent(in) :: mg,ng, vl(:) - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: vg(:), lidx(:),nl integer(psb_ipk_), intent(in) :: flag logical, intent(in) :: repl, globalcheck,usehash @@ -20,36 +20,36 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx, usehash interface - subroutine psb_cdals(m, n, parts, ictxt, desc, info) + subroutine psb_cdals(m, n, parts, ctxt, desc, info) use psb_desc_mod procedure(psb_parts) :: parts integer(psb_lpk_), intent(in) :: m,n - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt Type(psb_desc_type), intent(out) :: desc integer(psb_ipk_), intent(out) :: info end subroutine psb_cdals - subroutine psb_cdalv(v, ictxt, desc, info, flag) + subroutine psb_cdalv(v, ctxt, desc, info, flag) use psb_desc_mod - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(in) :: v(:) integer(psb_ipk_), intent(in), optional :: flag integer(psb_ipk_), intent(out) :: info Type(psb_desc_type), intent(out) :: desc end subroutine psb_cdalv - subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx, usehash) + subroutine psb_cd_inloc(v, ctxt, desc, info, globalcheck,idx, usehash) use psb_desc_mod implicit None - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_lpk_), intent(in) :: v(:) integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc logical, intent(in), optional :: globalcheck, usehash integer(psb_ipk_), intent(in), optional :: idx(:) end subroutine psb_cd_inloc - subroutine psb_cdrep(m, ictxt, desc,info) + subroutine psb_cdrep(m, ctxt, desc,info) use psb_desc_mod integer(psb_lpk_), intent(in) :: m - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt Type(psb_desc_type), intent(out) :: desc @@ -70,7 +70,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& name = 'psb_cdall' call psb_erractionsave(err_act) - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (count((/ present(vg),present(vl),& & present(parts),present(nl), present(repl) /)) /= 1) then info=psb_err_no_optional_arg_ @@ -95,7 +95,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& else n_ = mg endif - call psb_cdals(mg, n_, parts, ictxt, desc, info) + call psb_cdals(mg, n_, parts, ctxt, desc, info) else if (present(repl)) then @@ -110,7 +110,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& goto 9999 end if - call psb_cdrep(mg, ictxt, desc, info) + call psb_cdrep(mg, ctxt, desc, info) else if (present(vg)) then @@ -126,7 +126,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& nnv = size(vg) end if - call psb_cdalv(vg(1:nnv), ictxt, desc, info, flag=flag_) + call psb_cdalv(vg(1:nnv), ctxt, desc, info, flag=flag_) else if (present(vl)) then @@ -136,7 +136,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& nnv = size(vl) end if - call psb_cd_inloc(vl(1:nnv),ictxt,desc,info, globalcheck=globalcheck,idx=lidx) + call psb_cd_inloc(vl(1:nnv),ctxt,desc,info, globalcheck=globalcheck,idx=lidx) else if (present(nl)) then @@ -148,9 +148,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& if (usehash_) then nlp = nl - call psb_exscan_sum(ictxt,nlp) + call psb_exscan_sum(ctxt,nlp) lvl = [ (i,i=1,nl) ] + nlp - call psb_cd_inloc(lvl(1:nl),ictxt,desc,info, globalcheck=.false.) + call psb_cd_inloc(lvl(1:nl),ctxt,desc,info, globalcheck=.false.) else if (np == 1) then @@ -162,9 +162,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& select type(aa => desc%indxmap) type is (psb_repl_map) n_ = nl - call aa%repl_map_init(ictxt,n_,info) + call aa%repl_map_init(ctxt,n_,info) type is (psb_gen_block_map) - call aa%gen_block_map_init(ictxt,nl,info) + call aa%gen_block_map_init(ctxt,nl,info) class default ! This cannot happen info = psb_err_internal_error_ @@ -202,7 +202,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index 945d2c40..1387b1a8 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -40,10 +40,10 @@ ! n - integer. The number of columns. ! parts - external subroutine. The routine that contains the ! partitioning scheme. -! ictxt - integer. The communication context. +! ctxt - integer. The communication context. ! desc - type(psb_desc_type). The communication descriptor. ! info - integer. Error code (if any). -subroutine psb_cdals(m, n, parts, ictxt, desc, info) +subroutine psb_cdals(m, n, parts, ctxt, desc, info) use psb_base_mod use psi_mod use psb_repl_map_mod @@ -53,7 +53,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) procedure(psb_parts) :: parts !....Parameters... integer(psb_lpk_), intent(in) :: M,N - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt Type(psb_desc_type), intent(out) :: desc integer(psb_ipk_), intent(out) :: info @@ -77,7 +77,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np ! ....verify blacs grid correctness.. @@ -100,9 +100,9 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) !global check on m and n parameters if (me == psb_root_) then exch(1)=m; exch(2)=n; exch(3)=psb_cd_get_large_threshold() - call psb_bcast(ictxt,exch(1:3),root=psb_root_) + call psb_bcast(ctxt,exch(1:3),root=psb_root_) else - call psb_bcast(ictxt,exch(1:3),root=psb_root_) + call psb_bcast(ctxt,exch(1:3),root=psb_root_) if (exch(1) /= m) then err=550 call psb_errpush(err,name,m_err=(/1/)) @@ -240,9 +240,9 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(ictxt,m,info) + call aa%repl_map_init(ctxt,m,info) class default - call aa%init(ictxt,loc_idx(1:k),info) + call aa%init(ctxt,loc_idx(1:k),info) end select @@ -285,7 +285,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index fa0795a7..28d2ecc3 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -39,11 +39,11 @@ ! ! Arguments: ! v - integer(psb_ipk_), dimension(:). The array containg the partitioning scheme. -! ictxt - integer. The communication context. +! ctxt - integer. The communication context. ! desc - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! flag - integer. Are V's contents 0- or 1-based? -subroutine psb_cdalv(v, ictxt, desc, info, flag) +subroutine psb_cdalv(v, ctxt, desc, info, flag) use psb_base_mod use psi_mod use psb_repl_map_mod @@ -51,7 +51,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) use psb_hash_map_mod implicit None !....Parameters... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_), intent(in) :: v(:) integer(psb_ipk_), intent(in), optional :: flag integer(psb_ipk_), intent(out) :: info @@ -74,7 +74,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) err = 0 name = 'psb_cdalv' - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np,me m = size(v) @@ -103,9 +103,9 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) exch(1)=m exch(2)=n exch(3)=psb_cd_get_large_threshold() - call psb_bcast(ictxt,exch(1:3),root=psb_root_) + call psb_bcast(ctxt,exch(1:3),root=psb_root_) else - call psb_bcast(ictxt,exch(1:3),root=psb_root_) + call psb_bcast(ctxt,exch(1:3),root=psb_root_) if (exch(1) /= m) then err=550 l_err(1)=1 @@ -179,7 +179,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) if (np == 1) then allocate(psb_repl_map :: desc%indxmap, stat=info) else - if (psb_cd_choose_large_state(ictxt,m)) then + if (psb_cd_choose_large_state(ctxt,m)) then allocate(psb_hash_map :: desc%indxmap, stat=info) if (info == 0) allocate(desc%indxmap%tempvg(m),stat=info) if (info ==0) desc%indxmap%tempvg(1:m) = v(1:m) - flag_ @@ -191,11 +191,11 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(ictxt,m,info) + call aa%repl_map_init(ctxt,m,info) type is (psb_hash_map) - call aa%hash_map_init(ictxt,v,info) + call aa%hash_map_init(ctxt,v,info) type is (psb_glist_map) - call aa%glist_map_init(ictxt,v,info) + call aa%glist_map_init(ctxt,v,info) class default ! This cannot happen info = psb_err_internal_error_ @@ -219,7 +219,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdcpy.F90 b/base/tools/psb_cdcpy.F90 index 2977ccc2..d44c0c95 100644 --- a/base/tools/psb_cdcpy.F90 +++ b/base/tools/psb_cdcpy.F90 @@ -49,7 +49,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info) integer(psb_ipk_), intent(out) :: info !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -62,10 +62,10 @@ subroutine psb_cdcpy(desc_in, desc_out, info) call psb_erractionsave(err_act) name = 'psb_cdcpy' - ictxt = desc_in%get_context() + ctxt = desc_in%get_context() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': Entered' if (np == -1) then @@ -87,7 +87,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdins.F90 b/base/tools/psb_cdins.F90 index cc1fd1ef..4de000db 100644 --- a/base/tools/psb_cdins.F90 +++ b/base/tools/psb_cdins.F90 @@ -76,7 +76,7 @@ subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) !LOCALS..... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: dectype,mglob, nglob integer(psb_ipk_) :: np, me integer(psb_ipk_) :: nrow,ncol, err_act @@ -95,14 +95,14 @@ subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() dectype = desc_a%get_dectype() mglob = desc_a%get_global_rows() nglob = desc_a%get_global_cols() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -161,7 +161,7 @@ subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_lcdinsc(nz,ja,desc,info,jla,mask,lidx) !LOCALS..... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: dectype,mglob, nglob integer(psb_ipk_) :: np, me integer(psb_ipk_) :: nrow,ncol, err_act @@ -239,14 +239,14 @@ subroutine psb_lcdinsc(nz,ja,desc,info,jla,mask,lidx) goto 9999 endif - ictxt = desc%get_context() + ctxt = desc%get_context() dectype = desc%get_dectype() mglob = desc%get_global_rows() nglob = desc%get_global_cols() nrow = desc%get_local_rows() ncol = desc%get_local_cols() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -299,7 +299,7 @@ subroutine psb_lcdinsc(nz,ja,desc,info,jla,mask,lidx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdprt.f90 b/base/tools/psb_cdprt.f90 index 2c83af17..0ee64f2a 100644 --- a/base/tools/psb_cdprt.f90 +++ b/base/tools/psb_cdprt.f90 @@ -52,7 +52,7 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) integer(psb_ipk_) :: m, n_row, n_col,counter,idx,& & n_elem_recv,n_elem_send,proc,i, verb_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_ipk_) :: total_snd, total_rcv, total_xhcg, global_halo, global_points integer(psb_ipk_) :: local_snd, local_rcv, local_xhcg, local_halo, local_points @@ -74,9 +74,9 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) verb_ = 1 endif - ictxt = desc_p%get_ctxt() - call psb_info(ictxt, me,np) - call psb_min(ictxt,verb_) + ctxt = desc_p%get_ctxt() + call psb_info(ctxt, me,np) + call psb_min(ctxt,verb_) ! ! Level 1: Print global info @@ -92,8 +92,8 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) global_halo = local_halo av2s = v2s - call psb_sum(ictxt, global_halo) - call psb_sum(ictxt, av2s) + call psb_sum(ctxt, global_halo) + call psb_sum(ctxt, av2s) av2s = av2s / np if (me == psb_root_) then write(iout,*) ' Communication descriptor details ' @@ -103,7 +103,7 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) write(iout,*) ' Average volume to surface ratio :',av2s write(iout,*) end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (verb_ <= 1) return @@ -120,21 +120,21 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) write(iout,*) me,': Volume to surface ratio:',0.0_psb_dpk_ end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) end do if (me==psb_root_) write(iout,*) 'Communication data for : comm_halo' do i=0, np-1 if (me == i) & & call print_my_xchg(iout,desc_p,verbosity=verb_,data=psb_comm_halo_,glob=glob_) - call psb_barrier(ictxt) + call psb_barrier(ctxt) end do if (me==psb_root_) write(iout,*) 'Communication data for : comm_ext' do i=0, np-1 if (me == i) & & call print_my_xchg(iout,desc_p,verbosity=verb_,data=psb_comm_ext_,glob=glob_) - call psb_barrier(ictxt) + call psb_barrier(ctxt) end do return @@ -149,13 +149,13 @@ contains logical :: short_, glob_ integer(psb_ipk_) :: ip, nerv, nesd, totxch,idxr,idxs - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, data_, info, verb_ integer(psb_lpk_), allocatable :: gidx(:) class(psb_i_base_vect_type), pointer :: vpnt - ictxt = desc_p%get_ctxt() - call psb_info(ictxt, me,np) + ctxt = desc_p%get_ctxt() + call psb_info(ctxt, me,np) if (present(data)) then data_ = data else diff --git a/base/tools/psb_cdren.f90 b/base/tools/psb_cdren.f90 index 9a065028..f80c21ba 100644 --- a/base/tools/psb_cdren.f90 +++ b/base/tools/psb_cdren.f90 @@ -58,7 +58,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info) !....locals.... integer(psb_ipk_) :: i,j,np,me, n_col, kh, nh integer(psb_ipk_) :: dectype - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: n_row, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -70,13 +70,13 @@ subroutine psb_cdren(trans,iperm,desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() dectype = desc_a%get_dectype() n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -152,7 +152,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 index 93d7e348..b6f6bfb7 100644 --- a/base/tools/psb_cdrep.f90 +++ b/base/tools/psb_cdrep.f90 @@ -42,7 +42,7 @@ ! Total number of equations ! required. ! -! ictxt : (Global Input)Integer BLACS context for an NPx1 grid +! ctxt : (Global Input)Integer BLACS context for an NPx1 grid ! required. ! ! OUTPUT @@ -101,14 +101,14 @@ ! END OF desc OUTPUT FIELDS ! ! -subroutine psb_cdrep(m, ictxt, desc, info) +subroutine psb_cdrep(m, ctxt, desc, info) use psb_base_mod use psi_mod use psb_repl_map_mod implicit None !....Parameters... integer(psb_lpk_), intent(in) :: m - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info Type(psb_desc_type), intent(out) :: desc @@ -127,7 +127,7 @@ subroutine psb_cdrep(m, ictxt, desc, info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np n = m @@ -153,9 +153,9 @@ subroutine psb_cdrep(m, ictxt, desc, info) if (me == psb_root_) then exch(1)=m exch(2)=n - call psb_bcast(ictxt,exch(1:2),root=psb_root_) + call psb_bcast(ctxt,exch(1:2),root=psb_root_) else - call psb_bcast(ictxt,exch(1:2),root=psb_root_) + call psb_bcast(ctxt,exch(1:2),root=psb_root_) if (exch(1) /= m) then info=psb_err_parm_differs_among_procs_ l_err(1)=1 @@ -180,7 +180,7 @@ subroutine psb_cdrep(m, ictxt, desc, info) allocate(psb_repl_map :: desc%indxmap, stat=info) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(ictxt,m,info) + call aa%repl_map_init(ctxt,m,info) class default ! This cannot happen info = psb_err_internal_error_ @@ -198,7 +198,7 @@ subroutine psb_cdrep(m, ictxt, desc, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_cdrep diff --git a/base/tools/psb_cfree.f90 b/base/tools/psb_cfree.f90 index a5f79d8e..54c728f5 100644 --- a/base/tools/psb_cfree.f90 +++ b/base/tools/psb_cfree.f90 @@ -46,7 +46,7 @@ subroutine psb_cfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -61,9 +61,9 @@ subroutine psb_cfree_vect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -87,7 +87,7 @@ subroutine psb_cfree_vect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -101,7 +101,7 @@ subroutine psb_cfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -116,9 +116,9 @@ subroutine psb_cfree_vect_r2(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -139,7 +139,7 @@ subroutine psb_cfree_vect_r2(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -154,7 +154,7 @@ subroutine psb_cfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -169,9 +169,9 @@ subroutine psb_cfree_multivect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -195,7 +195,7 @@ subroutine psb_cfree_multivect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cfree_a.f90 b/base/tools/psb_cfree_a.f90 index dadb05a7..a8746071 100644 --- a/base/tools/psb_cfree_a.f90 +++ b/base/tools/psb_cfree_a.f90 @@ -48,7 +48,7 @@ subroutine psb_cfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_cfree(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_cfree(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_cfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_cfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_cfreev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cgetelem.f90 b/base/tools/psb_cgetelem.f90 index 2dc981e0..2789d1e4 100644 --- a/base/tools/psb_cgetelem.f90 +++ b/base/tools/psb_cgetelem.f90 @@ -55,7 +55,7 @@ function psb_c_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) @@ -75,9 +75,9 @@ function psb_c_getelem(x,index,desc_a,info) result(res) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -96,7 +96,7 @@ function psb_c_getelem(x,index,desc_a,info) result(res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 45f99156..e874c315 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -63,7 +63,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -80,9 +80,9 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,7 +146,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -191,7 +191,7 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) complex(psb_spk_), allocatable :: lval(:) @@ -209,9 +209,9 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -297,7 +297,7 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -314,9 +314,9 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -384,7 +384,7 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -429,9 +429,9 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -495,7 +495,7 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cins_a.f90 b/base/tools/psb_cins_a.f90 index 9fab5c02..688d06e9 100644 --- a/base/tools/psb_cins_a.f90 +++ b/base/tools/psb_cins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index d73a99dd..cac6c1e6 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -52,7 +52,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n @@ -68,10 +68,10 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() dectype = desc_a%get_dectype() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -118,7 +118,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index ef4fd438..96ed7fe7 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -62,7 +62,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_c_base_sparse_mat), intent(in), optional :: mold !....Locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit @@ -74,12 +74,12 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() ! check on BLACS grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -138,7 +138,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cspfree.f90 b/base/tools/psb_cspfree.f90 index 9a908d1b..51f40259 100644 --- a/base/tools/psb_cspfree.f90 +++ b/base/tools/psb_cspfree.f90 @@ -48,7 +48,7 @@ subroutine psb_cspfree(a, desc_a,info) type(psb_cspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: err_act character(len=20) :: name @@ -64,7 +64,7 @@ subroutine psb_cspfree(a, desc_a,info) call psb_errpush(info,name) return else - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() end if !...deallocate a.... @@ -73,7 +73,7 @@ subroutine psb_cspfree(a, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index ced2d5ff..8731c093 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -90,7 +90,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& @@ -126,10 +126,10 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -330,14 +330,14 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & acoo%val,iarcv,jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) + & iarcv,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) + & jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) @@ -426,14 +426,14 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) @@ -531,7 +531,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -558,7 +558,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& @@ -588,10 +588,10 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -774,14 +774,14 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& @@ -876,7 +876,7 @@ Subroutine psb_lcsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -902,7 +902,7 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -933,10 +933,10 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1131,14 +1131,14 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) @@ -1237,7 +1237,7 @@ Subroutine psb_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -1263,7 +1263,7 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -1296,10 +1296,10 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1504,14 +1504,14 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo) @@ -1610,7 +1610,7 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_cspins.F90 b/base/tools/psb_cspins.F90 index bc5ff7c5..15ea556f 100644 --- a/base/tools/psb_cspins.F90 +++ b/base/tools/psb_cspins.F90 @@ -64,7 +64,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -76,8 +76,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_cspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -186,7 +186,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -209,7 +209,7 @@ subroutine psb_cspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -221,8 +221,8 @@ subroutine psb_cspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) name = 'psb_cspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -284,7 +284,7 @@ subroutine psb_cspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -308,7 +308,7 @@ subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -320,8 +320,8 @@ subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) name = 'psb_cspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -383,7 +383,7 @@ subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -406,7 +406,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -428,8 +428,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - ictxt = desc_ar%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_ar%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -499,7 +499,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -522,7 +522,7 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -535,8 +535,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_cspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -651,7 +651,7 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_csprn.f90 b/base/tools/psb_csprn.f90 index 1dc4da91..82fb5be2 100644 --- a/base/tools/psb_csprn.f90 +++ b/base/tools/psb_csprn.f90 @@ -53,7 +53,7 @@ Subroutine psb_csprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -65,8 +65,8 @@ Subroutine psb_csprn(a, desc_a,info,clear) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start ' @@ -89,7 +89,7 @@ Subroutine psb_csprn(a, desc_a,info,clear) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_d_glob_transpose.F90 b/base/tools/psb_d_glob_transpose.F90 index 938adb0f..caf99400 100644 --- a/base/tools/psb_d_glob_transpose.F90 +++ b/base/tools/psb_d_glob_transpose.F90 @@ -110,7 +110,7 @@ subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -138,10 +138,10 @@ subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -288,14 +288,14 @@ subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& @@ -386,7 +386,7 @@ subroutine psb_ld_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ld_coo_glob_transpose @@ -407,7 +407,7 @@ subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -436,10 +436,10 @@ subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -588,14 +588,14 @@ subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + & iarcv(1:iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& @@ -692,7 +692,7 @@ subroutine psb_d_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_coo_glob_transpose @@ -711,20 +711,20 @@ subroutine psb_d_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_d_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -763,20 +763,20 @@ subroutine psb_d_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_d_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -815,20 +815,20 @@ subroutine psb_ld_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_ld_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -867,20 +867,20 @@ subroutine psb_ld_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_ld_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 18bbc0ec..9fdebb4d 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -52,7 +52,7 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) real(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -67,14 +67,14 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() + ctxt = map%p_desc_V%get_context() nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) if (info == psb_success_) call psb_csmm(done,map%mat_U2V,x,dzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then @@ -84,7 +84,7 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() + ctxt = map%desc_V%get_context() nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -94,7 +94,7 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) if (info == psb_success_) call psb_csmm(done,map%mat_U2V,xt,dzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then @@ -127,7 +127,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -142,8 +142,8 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_V%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then @@ -156,7 +156,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(done,map%mat_U2V,x,dzero,pty,info) if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) @@ -169,8 +169,8 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_V%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -190,7 +190,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(done,map%mat_U2V,ptx,dzero,pty,info) if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) @@ -235,7 +235,7 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) real(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -250,14 +250,14 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() + ctxt = map%p_desc_U%get_context() nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) if (info == psb_success_) call psb_csmm(done,map%mat_V2U,x,dzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then @@ -267,7 +267,7 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() + ctxt = map%desc_U%get_context() nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -277,7 +277,7 @@ subroutine psb_d_map_V2U_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) if (info == psb_success_) call psb_csmm(done,map%mat_V2U,xt,dzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then @@ -309,7 +309,7 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ @@ -324,8 +324,8 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_U%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then @@ -338,7 +338,7 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(done,map%mat_V2U,x,dzero,pty,info) if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) @@ -351,8 +351,8 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_U%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -373,7 +373,7 @@ subroutine psb_d_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(done,map%mat_V2U,ptx,dzero,pty,info) if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) diff --git a/base/tools/psb_d_par_csr_spspmm.f90 b/base/tools/psb_d_par_csr_spspmm.f90 index 04deeb3f..f9d110f7 100644 --- a/base/tools/psb_d_par_csr_spspmm.f90 +++ b/base/tools/psb_d_par_csr_spspmm.f90 @@ -73,7 +73,7 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_ld_csr_sparse_mat) :: ltcsr @@ -92,9 +92,9 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -151,7 +151,7 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -169,7 +169,7 @@ Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_ld_csr_sparse_mat) :: tcsr1 @@ -187,9 +187,9 @@ Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -246,7 +246,7 @@ Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index a2d8214d..7989929b 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -52,7 +52,7 @@ subroutine psb_dalloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -63,9 +63,9 @@ subroutine psb_dalloc_vect(x, desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -105,7 +105,7 @@ subroutine psb_dalloc_vect(x, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -133,7 +133,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -146,9 +146,9 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -177,9 +177,9 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -217,7 +217,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -236,7 +236,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -249,9 +249,9 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -275,9 +275,9 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -310,7 +310,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dallc_a.f90 b/base/tools/psb_dallc_a.f90 index 2633e088..8cd927fe 100644 --- a/base/tools/psb_dallc_a.f90 +++ b/base/tools/psb_dallc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_dallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_dallocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_dallocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 86ee0eb1..fac4198d 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -62,7 +62,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -74,13 +74,13 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) name = 'psb_dgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -118,7 +118,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -136,7 +136,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -148,13 +148,13 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch) name = 'psb_dgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -200,7 +200,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ @@ -232,7 +232,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) name = 'psb_dgeasb' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -249,7 +249,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) end if endif - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -289,7 +289,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dasb_a.f90 b/base/tools/psb_dasb_a.f90 index 82db47d5..2a62fedf 100644 --- a/base/tools/psb_dasb_a.f90 +++ b/base/tools/psb_dasb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_dasb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_dasb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_dasb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_dasb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_dasbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_dasbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_dasbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index c35e4493..fdafb500 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -90,7 +90,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_mpk_) :: icomm, minfo @@ -116,9 +116,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& @@ -189,7 +189,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_)then Write(debug_unit,*) me,' ',trim(name),& & ': BEGIN ',nhalo, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif ! ! Ok, since we are only estimating, do it as follows: @@ -217,7 +217,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_) then Write(debug_unit,*) me,' ',trim(name),':Start',& & lworks,lworkr, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif @@ -595,7 +595,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),':Done Crea_Index' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_move_alloc(t_halo_out,halo,info) ! @@ -674,7 +674,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),': converting indexes' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) @@ -703,7 +703,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dfree.f90 b/base/tools/psb_dfree.f90 index 7f51dc84..8e092dfa 100644 --- a/base/tools/psb_dfree.f90 +++ b/base/tools/psb_dfree.f90 @@ -46,7 +46,7 @@ subroutine psb_dfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -61,9 +61,9 @@ subroutine psb_dfree_vect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -87,7 +87,7 @@ subroutine psb_dfree_vect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -101,7 +101,7 @@ subroutine psb_dfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -116,9 +116,9 @@ subroutine psb_dfree_vect_r2(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -139,7 +139,7 @@ subroutine psb_dfree_vect_r2(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -154,7 +154,7 @@ subroutine psb_dfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -169,9 +169,9 @@ subroutine psb_dfree_multivect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -195,7 +195,7 @@ subroutine psb_dfree_multivect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dfree_a.f90 b/base/tools/psb_dfree_a.f90 index a5087078..0ce49ecc 100644 --- a/base/tools/psb_dfree_a.f90 +++ b/base/tools/psb_dfree_a.f90 @@ -48,7 +48,7 @@ subroutine psb_dfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_dfree(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_dfree(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_dfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_dfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_dfreev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dgetelem.f90 b/base/tools/psb_dgetelem.f90 index 8058b897..8f5247c7 100644 --- a/base/tools/psb_dgetelem.f90 +++ b/base/tools/psb_dgetelem.f90 @@ -55,7 +55,7 @@ function psb_d_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) @@ -75,9 +75,9 @@ function psb_d_getelem(x,index,desc_a,info) result(res) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -96,7 +96,7 @@ function psb_d_getelem(x,index,desc_a,info) result(res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index 4ee99acc..3e873ded 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -63,7 +63,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -80,9 +80,9 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,7 +146,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -191,7 +191,7 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) real(psb_dpk_), allocatable :: lval(:) @@ -209,9 +209,9 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -297,7 +297,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -314,9 +314,9 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -384,7 +384,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -429,9 +429,9 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -495,7 +495,7 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dins_a.f90 b/base/tools/psb_dins_a.f90 index 96a8d669..eb04ebaf 100644 --- a/base/tools/psb_dins_a.f90 +++ b/base/tools/psb_dins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index 1f623a64..cae01838 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -52,7 +52,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n @@ -68,10 +68,10 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() dectype = desc_a%get_dectype() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -118,7 +118,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 03193e66..457553f7 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -62,7 +62,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_d_base_sparse_mat), intent(in), optional :: mold !....Locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit @@ -74,12 +74,12 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() ! check on BLACS grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -138,7 +138,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 index 201c6b4f..06004348 100644 --- a/base/tools/psb_dspfree.f90 +++ b/base/tools/psb_dspfree.f90 @@ -48,7 +48,7 @@ subroutine psb_dspfree(a, desc_a,info) type(psb_dspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: err_act character(len=20) :: name @@ -64,7 +64,7 @@ subroutine psb_dspfree(a, desc_a,info) call psb_errpush(info,name) return else - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() end if !...deallocate a.... @@ -73,7 +73,7 @@ subroutine psb_dspfree(a, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index d4487757..e8a59e52 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -90,7 +90,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& @@ -126,10 +126,10 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -330,14 +330,14 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & acoo%val,iarcv,jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) + & iarcv,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) + & jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) @@ -426,14 +426,14 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) @@ -531,7 +531,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -558,7 +558,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& @@ -588,10 +588,10 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -774,14 +774,14 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& @@ -876,7 +876,7 @@ Subroutine psb_ldsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -902,7 +902,7 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -933,10 +933,10 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1131,14 +1131,14 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) @@ -1237,7 +1237,7 @@ Subroutine psb_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -1263,7 +1263,7 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -1296,10 +1296,10 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1504,14 +1504,14 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo) @@ -1610,7 +1610,7 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dspins.F90 b/base/tools/psb_dspins.F90 index 9816aade..3e9ef0cc 100644 --- a/base/tools/psb_dspins.F90 +++ b/base/tools/psb_dspins.F90 @@ -64,7 +64,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -76,8 +76,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_dspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -186,7 +186,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -209,7 +209,7 @@ subroutine psb_dspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -221,8 +221,8 @@ subroutine psb_dspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) name = 'psb_dspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -284,7 +284,7 @@ subroutine psb_dspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -308,7 +308,7 @@ subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -320,8 +320,8 @@ subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) name = 'psb_dspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -383,7 +383,7 @@ subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -406,7 +406,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -428,8 +428,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - ictxt = desc_ar%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_ar%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -499,7 +499,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -522,7 +522,7 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -535,8 +535,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_dspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -651,7 +651,7 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 index ebd05185..36e0531f 100644 --- a/base/tools/psb_dsprn.f90 +++ b/base/tools/psb_dsprn.f90 @@ -53,7 +53,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -65,8 +65,8 @@ Subroutine psb_dsprn(a, desc_a,info,clear) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start ' @@ -89,7 +89,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_eallc_a.f90 b/base/tools/psb_eallc_a.f90 index 6d360c31..c9c65634 100644 --- a/base/tools/psb_eallc_a.f90 +++ b/base/tools/psb_eallc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_eallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_eallocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_eallocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_easb_a.f90 b/base/tools/psb_easb_a.f90 index c93af356..baa8514d 100644 --- a/base/tools/psb_easb_a.f90 +++ b/base/tools/psb_easb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_easb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_easb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_easb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_easb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_easbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_easbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_easbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_efree_a.f90 b/base/tools/psb_efree_a.f90 index 738c5c3f..85baa0c0 100644 --- a/base/tools/psb_efree_a.f90 +++ b/base/tools/psb_efree_a.f90 @@ -48,7 +48,7 @@ subroutine psb_efree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_efree(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_efree(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_efreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_efreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_efreev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_eins_a.f90 b/base/tools/psb_eins_a.f90 index 87cf75d3..25744f5a 100644 --- a/base/tools/psb_eins_a.f90 +++ b/base/tools/psb_eins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 240c1efc..5681d2ae 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -59,7 +59,7 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) logical, intent(in), optional :: owned !....locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: n, iam, np character :: act integer(psb_ipk_) :: err_act @@ -75,8 +75,8 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt,iam,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,iam,np) if (present(iact)) then @@ -114,7 +114,7 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) character :: act integer(psb_ipk_) :: err_act character(len=20) :: name - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np if(psb_get_errstatus() /= 0) return @@ -198,8 +198,8 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) goto 9999 end if - ictxt = desc_a%get_context() - call psb_info(ictxt,iam,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,iam,np) if (present(iact)) then @@ -231,7 +231,7 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_i2allc_a.f90 b/base/tools/psb_i2allc_a.f90 index c7305e0c..52598304 100644 --- a/base/tools/psb_i2allc_a.f90 +++ b/base/tools/psb_i2allc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_i2alloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_i2alloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_i2alloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_i2alloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_i2allocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_i2allocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_i2allocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_i2asb_a.f90 b/base/tools/psb_i2asb_a.f90 index b76c39ff..97879105 100644 --- a/base/tools/psb_i2asb_a.f90 +++ b/base/tools/psb_i2asb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_i2asb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_i2asb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_i2asb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_i2asb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_i2asbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_i2asbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_i2asbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_i2free_a.f90 b/base/tools/psb_i2free_a.f90 index e1892cab..d5c7509c 100644 --- a/base/tools/psb_i2free_a.f90 +++ b/base/tools/psb_i2free_a.f90 @@ -48,7 +48,7 @@ subroutine psb_i2free(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_i2free(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_i2free(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_i2freev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_i2freev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_i2freev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_i2ins_a.f90 b/base/tools/psb_i2ins_a.f90 index 1db07847..975e619b 100644 --- a/base/tools/psb_i2ins_a.f90 +++ b/base/tools/psb_i2ins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_i2insvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_i2insvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_i2insvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_i2insi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_i2insi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_i2insi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_iallc.f90 b/base/tools/psb_iallc.f90 index 1dbb09f4..ac4ee840 100644 --- a/base/tools/psb_iallc.f90 +++ b/base/tools/psb_iallc.f90 @@ -52,7 +52,7 @@ subroutine psb_ialloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -63,9 +63,9 @@ subroutine psb_ialloc_vect(x, desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -105,7 +105,7 @@ subroutine psb_ialloc_vect(x, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -133,7 +133,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -146,9 +146,9 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -177,9 +177,9 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -217,7 +217,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -236,7 +236,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -249,9 +249,9 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -275,9 +275,9 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -310,7 +310,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index 1326a5e9..d296d2f9 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -62,7 +62,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -74,13 +74,13 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) name = 'psb_igeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -118,7 +118,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -136,7 +136,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -148,13 +148,13 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch) name = 'psb_igeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -200,7 +200,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ @@ -232,7 +232,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) name = 'psb_igeasb' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -249,7 +249,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) end if endif - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -289,7 +289,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index 6c2fd03e..31d92133 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -63,7 +63,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) integer(psb_ipk_),allocatable :: ovrlap_index(:),halo_index(:), ext_index(:) integer(psb_ipk_) :: i, n_col, dectype, err_act, n_row - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_mpk_) :: icomm integer(psb_ipk_) :: np,me logical :: ext_hv_ @@ -82,7 +82,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%get_context() + ctxt = desc%get_context() dectype = desc%get_dectype() n_row = desc%get_local_rows() n_col = desc%get_local_cols() @@ -104,7 +104,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) call psb_tic(idx_total) ! check on blacs grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -193,7 +193,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_ifree.f90 b/base/tools/psb_ifree.f90 index 2dbc0b80..a804913a 100644 --- a/base/tools/psb_ifree.f90 +++ b/base/tools/psb_ifree.f90 @@ -46,7 +46,7 @@ subroutine psb_ifree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -61,9 +61,9 @@ subroutine psb_ifree_vect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -87,7 +87,7 @@ subroutine psb_ifree_vect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -101,7 +101,7 @@ subroutine psb_ifree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -116,9 +116,9 @@ subroutine psb_ifree_vect_r2(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -139,7 +139,7 @@ subroutine psb_ifree_vect_r2(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -154,7 +154,7 @@ subroutine psb_ifree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -169,9 +169,9 @@ subroutine psb_ifree_multivect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -195,7 +195,7 @@ subroutine psb_ifree_multivect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index 9366a656..c9c0ed9b 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -63,7 +63,7 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -80,9 +80,9 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,7 +146,7 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -191,7 +191,7 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: lval(:) @@ -209,9 +209,9 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -297,7 +297,7 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -314,9 +314,9 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -384,7 +384,7 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -429,9 +429,9 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -495,7 +495,7 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_lallc.f90 b/base/tools/psb_lallc.f90 index 99870a11..85fd67e7 100644 --- a/base/tools/psb_lallc.f90 +++ b/base/tools/psb_lallc.f90 @@ -52,7 +52,7 @@ subroutine psb_lalloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -63,9 +63,9 @@ subroutine psb_lalloc_vect(x, desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -105,7 +105,7 @@ subroutine psb_lalloc_vect(x, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -133,7 +133,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -146,9 +146,9 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -177,9 +177,9 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -217,7 +217,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -236,7 +236,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -249,9 +249,9 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -275,9 +275,9 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -310,7 +310,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_lasb.f90 b/base/tools/psb_lasb.f90 index f7ab7824..8b80ae89 100644 --- a/base/tools/psb_lasb.f90 +++ b/base/tools/psb_lasb.f90 @@ -62,7 +62,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -74,13 +74,13 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) name = 'psb_lgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -118,7 +118,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -136,7 +136,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -148,13 +148,13 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) name = 'psb_lgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -200,7 +200,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ @@ -232,7 +232,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) name = 'psb_lgeasb' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -249,7 +249,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) end if endif - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -289,7 +289,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_lfree.f90 b/base/tools/psb_lfree.f90 index 85d7bd7e..6630601c 100644 --- a/base/tools/psb_lfree.f90 +++ b/base/tools/psb_lfree.f90 @@ -46,7 +46,7 @@ subroutine psb_lfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -61,9 +61,9 @@ subroutine psb_lfree_vect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -87,7 +87,7 @@ subroutine psb_lfree_vect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -101,7 +101,7 @@ subroutine psb_lfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -116,9 +116,9 @@ subroutine psb_lfree_vect_r2(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -139,7 +139,7 @@ subroutine psb_lfree_vect_r2(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -154,7 +154,7 @@ subroutine psb_lfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -169,9 +169,9 @@ subroutine psb_lfree_multivect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -195,7 +195,7 @@ subroutine psb_lfree_multivect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_lins.f90 b/base/tools/psb_lins.f90 index 8db980e9..42559a94 100644 --- a/base/tools/psb_lins.f90 +++ b/base/tools/psb_lins.f90 @@ -63,7 +63,7 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -80,9 +80,9 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,7 +146,7 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -191,7 +191,7 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) integer(psb_lpk_), allocatable :: lval(:) @@ -209,9 +209,9 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -297,7 +297,7 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -314,9 +314,9 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -384,7 +384,7 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -429,9 +429,9 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -495,7 +495,7 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_mallc_a.f90 b/base/tools/psb_mallc_a.f90 index fc545678..c815e8f9 100644 --- a/base/tools/psb_mallc_a.f90 +++ b/base/tools/psb_mallc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_malloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_malloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_malloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_malloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_mallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_mallocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_mallocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_masb_a.f90 b/base/tools/psb_masb_a.f90 index 7999cb03..50f2b768 100644 --- a/base/tools/psb_masb_a.f90 +++ b/base/tools/psb_masb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_masb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_masb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_masb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_masb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_masbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_masbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_masbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_mfree_a.f90 b/base/tools/psb_mfree_a.f90 index 3f534b2b..c2f57f21 100644 --- a/base/tools/psb_mfree_a.f90 +++ b/base/tools/psb_mfree_a.f90 @@ -48,7 +48,7 @@ subroutine psb_mfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_mfree(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_mfree(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_mfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_mfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_mfreev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_mins_a.f90 b/base/tools/psb_mins_a.f90 index fa3ff081..d1549c92 100644 --- a/base/tools/psb_mins_a.f90 +++ b/base/tools/psb_mins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_s_glob_transpose.F90 b/base/tools/psb_s_glob_transpose.F90 index e747b270..c7dc818f 100644 --- a/base/tools/psb_s_glob_transpose.F90 +++ b/base/tools/psb_s_glob_transpose.F90 @@ -110,7 +110,7 @@ subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -138,10 +138,10 @@ subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -288,14 +288,14 @@ subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& @@ -386,7 +386,7 @@ subroutine psb_ls_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_ls_coo_glob_transpose @@ -407,7 +407,7 @@ subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -436,10 +436,10 @@ subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -588,14 +588,14 @@ subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + & iarcv(1:iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& @@ -692,7 +692,7 @@ subroutine psb_s_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_s_coo_glob_transpose @@ -711,20 +711,20 @@ subroutine psb_s_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_s_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -763,20 +763,20 @@ subroutine psb_s_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_s_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -815,20 +815,20 @@ subroutine psb_ls_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_ls_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -867,20 +867,20 @@ subroutine psb_ls_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_ls_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index f20ff196..6b6b09aa 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -52,7 +52,7 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) real(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -67,14 +67,14 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() + ctxt = map%p_desc_V%get_context() nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,x,szero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then @@ -84,7 +84,7 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() + ctxt = map%desc_V%get_context() nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -94,7 +94,7 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,xt,szero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then @@ -127,7 +127,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -142,8 +142,8 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_V%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then @@ -156,7 +156,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,x,szero,pty,info) if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) @@ -169,8 +169,8 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_V%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -190,7 +190,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(sone,map%mat_U2V,ptx,szero,pty,info) if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) @@ -235,7 +235,7 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) real(psb_spk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -250,14 +250,14 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() + ctxt = map%p_desc_U%get_context() nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,x,szero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then @@ -267,7 +267,7 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() + ctxt = map%desc_U%get_context() nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -277,7 +277,7 @@ subroutine psb_s_map_V2U_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,xt,szero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then @@ -309,7 +309,7 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) real(psb_spk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ @@ -324,8 +324,8 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_U%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then @@ -338,7 +338,7 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,x,szero,pty,info) if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) @@ -351,8 +351,8 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_U%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -373,7 +373,7 @@ subroutine psb_s_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(sone,map%mat_V2U,ptx,szero,pty,info) if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) diff --git a/base/tools/psb_s_par_csr_spspmm.f90 b/base/tools/psb_s_par_csr_spspmm.f90 index 928ff101..549aeba4 100644 --- a/base/tools/psb_s_par_csr_spspmm.f90 +++ b/base/tools/psb_s_par_csr_spspmm.f90 @@ -73,7 +73,7 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_ls_csr_sparse_mat) :: ltcsr @@ -92,9 +92,9 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -151,7 +151,7 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -169,7 +169,7 @@ Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_ls_csr_sparse_mat) :: tcsr1 @@ -187,9 +187,9 @@ Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -246,7 +246,7 @@ Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sallc.f90 b/base/tools/psb_sallc.f90 index e4286f40..941ce917 100644 --- a/base/tools/psb_sallc.f90 +++ b/base/tools/psb_sallc.f90 @@ -52,7 +52,7 @@ subroutine psb_salloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -63,9 +63,9 @@ subroutine psb_salloc_vect(x, desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -105,7 +105,7 @@ subroutine psb_salloc_vect(x, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -133,7 +133,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -146,9 +146,9 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -177,9 +177,9 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -217,7 +217,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -236,7 +236,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -249,9 +249,9 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -275,9 +275,9 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -310,7 +310,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sallc_a.f90 b/base/tools/psb_sallc_a.f90 index 6f783584..3b511d61 100644 --- a/base/tools/psb_sallc_a.f90 +++ b/base/tools/psb_sallc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_salloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_salloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_salloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_salloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_sallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_sallocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_sallocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index 36b98c7c..c23ada14 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -62,7 +62,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -74,13 +74,13 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) name = 'psb_sgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -118,7 +118,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -136,7 +136,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -148,13 +148,13 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch) name = 'psb_sgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -200,7 +200,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ @@ -232,7 +232,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) name = 'psb_sgeasb' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -249,7 +249,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) end if endif - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -289,7 +289,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sasb_a.f90 b/base/tools/psb_sasb_a.f90 index 4ce6201a..76dbdafb 100644 --- a/base/tools/psb_sasb_a.f90 +++ b/base/tools/psb_sasb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_sasb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_sasb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_sasb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_sasb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_sasbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_sasbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_sasbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index d57e20ed..40ac778f 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -90,7 +90,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_mpk_) :: icomm, minfo @@ -116,9 +116,9 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& @@ -189,7 +189,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_)then Write(debug_unit,*) me,' ',trim(name),& & ': BEGIN ',nhalo, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif ! ! Ok, since we are only estimating, do it as follows: @@ -217,7 +217,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_) then Write(debug_unit,*) me,' ',trim(name),':Start',& & lworks,lworkr, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif @@ -595,7 +595,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),':Done Crea_Index' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_move_alloc(t_halo_out,halo,info) ! @@ -674,7 +674,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),': converting indexes' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) @@ -703,7 +703,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sfree.f90 b/base/tools/psb_sfree.f90 index 39e01666..add6162b 100644 --- a/base/tools/psb_sfree.f90 +++ b/base/tools/psb_sfree.f90 @@ -46,7 +46,7 @@ subroutine psb_sfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -61,9 +61,9 @@ subroutine psb_sfree_vect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -87,7 +87,7 @@ subroutine psb_sfree_vect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -101,7 +101,7 @@ subroutine psb_sfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -116,9 +116,9 @@ subroutine psb_sfree_vect_r2(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -139,7 +139,7 @@ subroutine psb_sfree_vect_r2(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -154,7 +154,7 @@ subroutine psb_sfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -169,9 +169,9 @@ subroutine psb_sfree_multivect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -195,7 +195,7 @@ subroutine psb_sfree_multivect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sfree_a.f90 b/base/tools/psb_sfree_a.f90 index 7cddb76f..036bb903 100644 --- a/base/tools/psb_sfree_a.f90 +++ b/base/tools/psb_sfree_a.f90 @@ -48,7 +48,7 @@ subroutine psb_sfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_sfree(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_sfree(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_sfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_sfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_sfreev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sgetelem.f90 b/base/tools/psb_sgetelem.f90 index f0eceee2..244947b1 100644 --- a/base/tools/psb_sgetelem.f90 +++ b/base/tools/psb_sgetelem.f90 @@ -55,7 +55,7 @@ function psb_s_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) @@ -75,9 +75,9 @@ function psb_s_getelem(x,index,desc_a,info) result(res) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -96,7 +96,7 @@ function psb_s_getelem(x,index,desc_a,info) result(res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 8fc5c312..cb878c64 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -63,7 +63,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -80,9 +80,9 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,7 +146,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -191,7 +191,7 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) real(psb_spk_), allocatable :: lval(:) @@ -209,9 +209,9 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -297,7 +297,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -314,9 +314,9 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -384,7 +384,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -429,9 +429,9 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -495,7 +495,7 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sins_a.f90 b/base/tools/psb_sins_a.f90 index bf0c7e42..629ad783 100644 --- a/base/tools/psb_sins_a.f90 +++ b/base/tools/psb_sins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index 7092ab4b..10e37d58 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -52,7 +52,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n @@ -68,10 +68,10 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() dectype = desc_a%get_dectype() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -118,7 +118,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index 87d34f86..f4e6169d 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -62,7 +62,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_s_base_sparse_mat), intent(in), optional :: mold !....Locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit @@ -74,12 +74,12 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() ! check on BLACS grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -138,7 +138,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sspfree.f90 b/base/tools/psb_sspfree.f90 index f55c8718..968e9f9a 100644 --- a/base/tools/psb_sspfree.f90 +++ b/base/tools/psb_sspfree.f90 @@ -48,7 +48,7 @@ subroutine psb_sspfree(a, desc_a,info) type(psb_sspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: err_act character(len=20) :: name @@ -64,7 +64,7 @@ subroutine psb_sspfree(a, desc_a,info) call psb_errpush(info,name) return else - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() end if !...deallocate a.... @@ -73,7 +73,7 @@ subroutine psb_sspfree(a, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index f6fad075..609d41b4 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -90,7 +90,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& @@ -126,10 +126,10 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -330,14 +330,14 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & acoo%val,iarcv,jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) + & iarcv,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) + & jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) @@ -426,14 +426,14 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) @@ -531,7 +531,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -558,7 +558,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& @@ -588,10 +588,10 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -774,14 +774,14 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& @@ -876,7 +876,7 @@ Subroutine psb_lssphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -902,7 +902,7 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -933,10 +933,10 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1131,14 +1131,14 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) @@ -1237,7 +1237,7 @@ Subroutine psb_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -1263,7 +1263,7 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -1296,10 +1296,10 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1504,14 +1504,14 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,& & acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo) @@ -1610,7 +1610,7 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_sspins.F90 b/base/tools/psb_sspins.F90 index 464dd953..1fd6eed0 100644 --- a/base/tools/psb_sspins.F90 +++ b/base/tools/psb_sspins.F90 @@ -64,7 +64,7 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -76,8 +76,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_sspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -186,7 +186,7 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -209,7 +209,7 @@ subroutine psb_sspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -221,8 +221,8 @@ subroutine psb_sspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) name = 'psb_sspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -284,7 +284,7 @@ subroutine psb_sspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -308,7 +308,7 @@ subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -320,8 +320,8 @@ subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) name = 'psb_sspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -383,7 +383,7 @@ subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -406,7 +406,7 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -428,8 +428,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - ictxt = desc_ar%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_ar%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -499,7 +499,7 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -522,7 +522,7 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -535,8 +535,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_sspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -651,7 +651,7 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_ssprn.f90 b/base/tools/psb_ssprn.f90 index 663ba185..602867e6 100644 --- a/base/tools/psb_ssprn.f90 +++ b/base/tools/psb_ssprn.f90 @@ -53,7 +53,7 @@ Subroutine psb_ssprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -65,8 +65,8 @@ Subroutine psb_ssprn(a, desc_a,info,clear) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start ' @@ -89,7 +89,7 @@ Subroutine psb_ssprn(a, desc_a,info,clear) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_z_glob_transpose.F90 b/base/tools/psb_z_glob_transpose.F90 index 4ee53c38..9bc92da3 100644 --- a/base/tools/psb_z_glob_transpose.F90 +++ b/base/tools/psb_z_glob_transpose.F90 @@ -110,7 +110,7 @@ subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) integer(psb_ipk_), intent(out) :: info ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_lpk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -138,10 +138,10 @@ subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -288,14 +288,14 @@ subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),acoo%ia(nzl+1:nzl+iszr),& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ia(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%ja(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& @@ -386,7 +386,7 @@ subroutine psb_lz_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_lz_coo_glob_transpose @@ -407,7 +407,7 @@ subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) type(psb_desc_type), intent(out), optional :: desc_rx integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc, err_act, j integer(psb_ipk_) :: i, k, idx, r, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -436,10 +436,10 @@ subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_r%get_context() + ctxt = desc_r%get_context() icomm = desc_r%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -588,14 +588,14 @@ subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& & acoo%val(nzl+1:nzl+iszr),iarcv(1:iszr),& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ictxt,info) + & acoo%val(nzl+1:nzl+iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv(1:iszr),rvsz,brvindx,ictxt,info) + & iarcv(1:iszr),rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv(1:iszr),rvsz,brvindx,ictxt,info) + & jarcv(1:iszr),rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& @@ -692,7 +692,7 @@ subroutine psb_z_coo_glob_transpose(ain,desc_r,info,atrans,desc_c,desc_rx) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_z_coo_glob_transpose @@ -711,20 +711,20 @@ subroutine psb_z_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_z_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -763,20 +763,20 @@ subroutine psb_z_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_z_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -815,20 +815,20 @@ subroutine psb_lz_simple_glob_transpose_ip(ain,desc_a,info) ! type(psb_lz_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if @@ -867,20 +867,20 @@ subroutine psb_lz_simple_glob_transpose(ain,aout,desc_a,info) ! type(psb_lz_coo_sparse_mat) :: tmpc1, tmpc2 integer(psb_ipk_) :: nz1, nz2, nzh, nz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_lpk_) :: i, j, k, nrow, ncol, nlz integer(psb_lpk_), allocatable :: ilv(:) character(len=80) :: aname logical, parameter :: debug=.false., dump=.false., debug_sync=.false. - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() if (debug_sync) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (me == 0) write(0,*) 'Start htranspose ' end if diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index b41f1fc9..eea44099 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -52,7 +52,7 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) complex(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ @@ -67,14 +67,14 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() + ctxt = map%p_desc_V%get_context() nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_U,info,work=work) if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,x,zzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_V,info) if (info /= psb_success_) then @@ -84,7 +84,7 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() + ctxt = map%desc_V%get_context() nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -94,7 +94,7 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_U,info,work=work) if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,xt,zzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_V)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_V,info) if (info /= psb_success_) then @@ -127,7 +127,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2 ,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_U2V_v' info = psb_success_ @@ -142,8 +142,8 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_V%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_V%get_global_rows() nc2 = map%p_desc_V%get_local_cols() if (present(vty)) then @@ -156,7 +156,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,x,zzero,pty,info) if ((info == psb_success_) .and. map%p_desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) @@ -169,8 +169,8 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_V%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_V%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_U%get_local_rows() nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() @@ -190,7 +190,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(zone,map%mat_U2V,ptx,zzero,pty,info) if ((info == psb_success_) .and. map%desc_V%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) @@ -235,7 +235,7 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) complex(psb_dpk_), allocatable :: xt(:), yt(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U' info = psb_success_ @@ -250,14 +250,14 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() + ctxt = map%p_desc_U%get_context() nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() allocate(yt(nc2),stat=info) if (info == psb_success_) call psb_halo(x,map%p_desc_V,info,work=work) if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,x,zzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_U,info) if (info /= psb_success_) then @@ -267,7 +267,7 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() + ctxt = map%desc_U%get_context() nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -277,7 +277,7 @@ subroutine psb_z_map_V2U_a(alpha,x,beta,y,map,info,work) if (info == psb_success_) call psb_halo(xt,map%desc_V,info,work=work) if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,xt,zzero,yt,info) if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_U)) then - call psb_sum(ictxt,yt(1:nr2)) + call psb_sum(ctxt,yt(1:nr2)) end if if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_U,info) if (info /= psb_success_) then @@ -309,7 +309,7 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) complex(psb_dpk_), allocatable :: xta(:), yta(:) integer(psb_ipk_) :: i, j, nr1, nc1,nr2, nc2,& & map_kind, nr, iam, np - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=20), parameter :: name='psb_map_V2U_v' info = psb_success_ @@ -324,8 +324,8 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) select case(map_kind) case(psb_map_aggr_) - ictxt = map%p_desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%p_desc_U%get_context() + call psb_info(ctxt,iam,np) nr2 = map%p_desc_U%get_global_rows() nc2 = map%p_desc_U%get_local_cols() if (present(vty)) then @@ -338,7 +338,7 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,x,zzero,pty,info) if ((info == psb_success_) .and. map%p_desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_U,info) @@ -351,8 +351,8 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) case(psb_map_gen_linear_) - ictxt = map%desc_U%get_context() - call psb_info(ictxt,iam,np) + ctxt = map%desc_U%get_context() + call psb_info(ctxt,iam,np) nr1 = map%desc_V%get_local_rows() nc1 = map%desc_V%get_local_cols() nr2 = map%desc_U%get_global_rows() @@ -373,7 +373,7 @@ subroutine psb_z_map_V2U_v(alpha,x,beta,y,map,info,work,vtx,vty) if (info == psb_success_) call psb_csmm(zone,map%mat_V2U,ptx,zzero,pty,info) if ((info == psb_success_) .and. map%desc_U%is_repl().and.(np>1)) then yta = pty%get_vect() - call psb_sum(ictxt,yta(1:nr2)) + call psb_sum(ctxt,yta(1:nr2)) call pty%set(yta) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_U,info) diff --git a/base/tools/psb_z_par_csr_spspmm.f90 b/base/tools/psb_z_par_csr_spspmm.f90 index c59f183f..4b88ffab 100644 --- a/base/tools/psb_z_par_csr_spspmm.f90 +++ b/base/tools/psb_z_par_csr_spspmm.f90 @@ -73,7 +73,7 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: ncol, nnz type(psb_lz_csr_sparse_mat) :: ltcsr @@ -92,9 +92,9 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -151,7 +151,7 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -169,7 +169,7 @@ Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_lpk_) :: nacol, nccol, nnz type(psb_lz_csr_sparse_mat) :: tcsr1 @@ -187,9 +187,9 @@ Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -246,7 +246,7 @@ Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index 1c86b430..fa84827e 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -52,7 +52,7 @@ subroutine psb_zalloc_vect(x, desc_a,info) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -63,9 +63,9 @@ subroutine psb_zalloc_vect(x, desc_a,info) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -105,7 +105,7 @@ subroutine psb_zalloc_vect(x, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -133,7 +133,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) integer(psb_ipk_), optional, intent(in) :: n,lb !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -146,9 +146,9 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -177,9 +177,9 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -217,7 +217,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -236,7 +236,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ integer(psb_ipk_) :: exch(1) integer(psb_ipk_) :: debug_level, debug_unit @@ -249,9 +249,9 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -275,9 +275,9 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -310,7 +310,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zallc_a.f90 b/base/tools/psb_zallc_a.f90 index 96cbfdf9..1af815e4 100644 --- a/base/tools/psb_zallc_a.f90 +++ b/base/tools/psb_zallc_a.f90 @@ -55,7 +55,7 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) !locals integer(psb_ipk_) :: err,nr,i,j,n_,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: exch(3) character(len=20) :: name @@ -68,9 +68,9 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -92,9 +92,9 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) !global check on n parameters if (me == psb_root_) then exch(1)=n_ - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) else - call psb_bcast(ictxt,exch(1),root=psb_root_) + call psb_bcast(ctxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ call psb_errpush(info,name,i_err=(/ione/)) @@ -125,7 +125,7 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -184,7 +184,7 @@ subroutine psb_zallocv(x, desc_a,info,n) !locals integer(psb_ipk_) :: nr,i,err_act - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -198,9 +198,9 @@ subroutine psb_zallocv(x, desc_a,info,n) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -240,7 +240,7 @@ subroutine psb_zallocv(x, desc_a,info,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 883ba129..e3d3a555 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -62,7 +62,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -74,13 +74,13 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) name = 'psb_zgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -118,7 +118,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -136,7 +136,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, i, n integer(psb_ipk_) :: i1sz,nrow,ncol, err_act logical :: scratch_ @@ -148,13 +148,13 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch) name = 'psb_zgeasb_v' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -200,7 +200,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -219,7 +219,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act, n_ logical :: scratch_ @@ -232,7 +232,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) name = 'psb_zgeasb' - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -249,7 +249,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) end if endif - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -289,7 +289,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zasb_a.f90 b/base/tools/psb_zasb_a.f90 index 6f0e8221..e8c9db99 100644 --- a/base/tools/psb_zasb_a.f90 +++ b/base/tools/psb_zasb_a.f90 @@ -52,7 +52,7 @@ subroutine psb_zasb(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,nrow,ncol, err_act integer(psb_ipk_) :: i1sz, i2sz integer(psb_ipk_) :: debug_level, debug_unit @@ -75,9 +75,9 @@ subroutine psb_zasb(x, desc_a, info, scratch) call psb_errpush(info,name) goto 9999 endif - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_) & @@ -97,7 +97,7 @@ subroutine psb_zasb(x, desc_a, info, scratch) endif ! check size - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() i1sz = size(x,dim=1) @@ -130,7 +130,7 @@ subroutine psb_zasb(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -189,7 +189,7 @@ subroutine psb_zasbv(x, desc_a, info, scratch) logical, intent(in), optional :: scratch ! local variables - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: i1sz,nrow,ncol, err_act integer(psb_ipk_) :: debug_level, debug_unit @@ -203,13 +203,13 @@ subroutine psb_zasbv(x, desc_a, info, scratch) info = psb_err_internal_error_ ; goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() scratch_ = .false. if (present(scratch)) scratch_ = scratch - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then @@ -254,7 +254,7 @@ subroutine psb_zasbv(x, desc_a, info, scratch) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index f53ad714..32d0b51a 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -90,7 +90,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer(psb_lpk_) :: gidx, lnz - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np integer(psb_mpk_) :: icomm, minfo @@ -116,9 +116,9 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& @@ -189,7 +189,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_)then Write(debug_unit,*) me,' ',trim(name),& & ': BEGIN ',nhalo, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif ! ! Ok, since we are only estimating, do it as follows: @@ -217,7 +217,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) If (debug_level >= psb_debug_outer_) then Write(debug_unit,*) me,' ',trim(name),':Start',& & lworks,lworkr, desc_ov%indxmap%get_state() - call psb_barrier(ictxt) + call psb_barrier(ctxt) endif @@ -595,7 +595,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),':Done Crea_Index' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_move_alloc(t_halo_out,halo,info) ! @@ -674,7 +674,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) then write(debug_unit,*) me,' ',trim(name),': converting indexes' - call psb_barrier(ictxt) + call psb_barrier(ctxt) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) @@ -703,7 +703,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zfree.f90 b/base/tools/psb_zfree.f90 index b544970b..6f7f057b 100644 --- a/base/tools/psb_zfree.f90 +++ b/base/tools/psb_zfree.f90 @@ -46,7 +46,7 @@ subroutine psb_zfree_vect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -61,9 +61,9 @@ subroutine psb_zfree_vect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -87,7 +87,7 @@ subroutine psb_zfree_vect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -101,7 +101,7 @@ subroutine psb_zfree_vect_r2(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act, i character(len=20) :: name @@ -116,9 +116,9 @@ subroutine psb_zfree_vect_r2(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -139,7 +139,7 @@ subroutine psb_zfree_vect_r2(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -154,7 +154,7 @@ subroutine psb_zfree_multivect(x, desc_a, info) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act character(len=20) :: name @@ -169,9 +169,9 @@ subroutine psb_zfree_multivect(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -195,7 +195,7 @@ subroutine psb_zfree_multivect(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zfree_a.f90 b/base/tools/psb_zfree_a.f90 index c7bd6c00..95fa38d1 100644 --- a/base/tools/psb_zfree_a.f90 +++ b/base/tools/psb_zfree_a.f90 @@ -48,7 +48,7 @@ subroutine psb_zfree(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -65,9 +65,9 @@ subroutine psb_zfree(x, desc_a, info) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -93,7 +93,7 @@ subroutine psb_zfree(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -117,7 +117,7 @@ subroutine psb_zfreev(x, desc_a, info) integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act character(len=20) :: name @@ -133,9 +133,9 @@ subroutine psb_zfreev(x, desc_a, info) call psb_errpush(info,name) goto 9999 end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -159,7 +159,7 @@ subroutine psb_zfreev(x, desc_a, info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zgetelem.f90 b/base/tools/psb_zgetelem.f90 index 030c62b8..2024f094 100644 --- a/base/tools/psb_zgetelem.f90 +++ b/base/tools/psb_zgetelem.f90 @@ -55,7 +55,7 @@ function psb_z_getelem(x,index,desc_a,info) result(res) !locals integer(psb_ipk_) :: localindex(1) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_lpk_) :: gindex(1) integer(psb_lpk_), allocatable :: myidx(:),mylocal(:) @@ -75,9 +75,9 @@ function psb_z_getelem(x,index,desc_a,info) result(res) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -96,7 +96,7 @@ function psb_z_getelem(x,index,desc_a,info) result(res) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index a5c1edb3..19020379 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -63,7 +63,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -80,9 +80,9 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -146,7 +146,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -191,7 +191,7 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) complex(psb_dpk_), allocatable :: lval(:) @@ -209,9 +209,9 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -269,7 +269,7 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -297,7 +297,7 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -314,9 +314,9 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -384,7 +384,7 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -412,7 +412,7 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -429,9 +429,9 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local) goto 9999 end if - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -495,7 +495,7 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zins_a.f90 b/base/tools/psb_zins_a.f90 index 19d5a869..4b068117 100644 --- a/base/tools/psb_zins_a.f90 +++ b/base/tools/psb_zins_a.f90 @@ -68,7 +68,7 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -87,9 +87,9 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -170,7 +170,7 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -249,7 +249,7 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) !locals..... integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ @@ -268,9 +268,9 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) return end if - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -361,7 +361,7 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index 84222f07..823fee7a 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -52,7 +52,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) integer(psb_ipk_), optional, intent(in) :: nnz !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me, err_act integer(psb_ipk_) :: loc_row,loc_col, nnz_, dectype integer(psb_lpk_) :: m, n @@ -68,10 +68,10 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() dectype = desc_a%get_dectype() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! ....verify blacs grid correctness.. if (np == -1) then info = psb_err_context_error_ @@ -118,7 +118,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 9ec41ecb..b5966110 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -62,7 +62,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) character(len=*), optional, intent(in) :: afmt class(psb_z_base_sparse_mat), intent(in), optional :: mold !....Locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me, err_act integer(psb_ipk_) :: n_row,n_col integer(psb_ipk_) :: debug_level, debug_unit @@ -74,12 +74,12 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() ! check on BLACS grid - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (np == -1) then info = psb_err_context_error_ call psb_errpush(info,name) @@ -138,7 +138,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zspfree.f90 b/base/tools/psb_zspfree.f90 index 01c1883e..73f0bb27 100644 --- a/base/tools/psb_zspfree.f90 +++ b/base/tools/psb_zspfree.f90 @@ -48,7 +48,7 @@ subroutine psb_zspfree(a, desc_a,info) type(psb_zspmat_type), intent(inout) :: a integer(psb_ipk_), intent(out) :: info !...locals.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: err_act character(len=20) :: name @@ -64,7 +64,7 @@ subroutine psb_zspfree(a, desc_a,info) call psb_errpush(info,name) return else - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() end if !...deallocate a.... @@ -73,7 +73,7 @@ subroutine psb_zspfree(a, desc_a,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 1021c726..6aece956 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -90,7 +90,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, & & n_el_send,k,n_el_recv,idx, r, tot_elem,& @@ -126,10 +126,10 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -330,14 +330,14 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,iarcv,jarcv,rvsz,brvindx,ictxt,info) + & acoo%val,iarcv,jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & iarcv,rvsz,brvindx,ictxt,info) + & iarcv,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & jarcv,rvsz,brvindx,ictxt,info) + & jarcv,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) @@ -426,14 +426,14 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) @@ -531,7 +531,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -558,7 +558,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& character(len=5), optional :: outfmt integer(psb_ipk_), intent(in), optional :: data ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter, proc, i, n_el_send,n_el_recv, & & n_elem, j, ipx,mat_recv, idxs,idxr,nz,& @@ -588,10 +588,10 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -774,14 +774,14 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& @@ -876,7 +876,7 @@ Subroutine psb_lzsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -902,7 +902,7 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -933,10 +933,10 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1131,14 +1131,14 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(iasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) @@ -1237,7 +1237,7 @@ Subroutine psb_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -1263,7 +1263,7 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& integer(psb_ipk_), intent(in), optional :: data type(psb_desc_type),Intent(in), optional, target :: col_desc ! ...local scalars.... - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: counter,proc,i, n_el_send,n_el_recv,& & n_elem, j,ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& @@ -1296,10 +1296,10 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() icomm = desc_a%get_mpic() - Call psb_info(ictxt, me, np) + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': Start' @@ -1504,14 +1504,14 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& select case(psb_get_sp_a2av_alg()) case(psb_sp_a2av_smpl_triad_) call psb_simple_triad_a2av(valsnd,liasnd,ljasnd,sdsz,bsdindx,& - & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%val,acoo%ia,acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_smpl_v_) call psb_simple_a2av(valsnd,sdsz,bsdindx,& - & acoo%val,rvsz,brvindx,ictxt,info) + & acoo%val,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(liasnd,sdsz,bsdindx,& - & acoo%ia,rvsz,brvindx,ictxt,info) + & acoo%ia,rvsz,brvindx,ctxt,info) if (info == psb_success_) call psb_simple_a2av(ljasnd,sdsz,bsdindx,& - & acoo%ja,rvsz,brvindx,ictxt,info) + & acoo%ja,rvsz,brvindx,ctxt,info) case(psb_sp_a2av_mpi_) call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,& & acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo) @@ -1610,7 +1610,7 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zspins.F90 b/base/tools/psb_zspins.F90 index e9970ac5..525ed415 100644 --- a/base/tools/psb_zspins.F90 +++ b/base/tools/psb_zspins.F90 @@ -64,7 +64,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -76,8 +76,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_zspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -186,7 +186,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -209,7 +209,7 @@ subroutine psb_zspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -221,8 +221,8 @@ subroutine psb_zspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) name = 'psb_zspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -284,7 +284,7 @@ subroutine psb_zspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -308,7 +308,7 @@ subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) integer(psb_ipk_) :: nrow, err_act, ncol, spstate, nz, i, j integer(psb_lpk_) :: ir - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -320,8 +320,8 @@ subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) name = 'psb_zspins_csr' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nr < 0) then info = 1111 @@ -383,7 +383,7 @@ subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -406,7 +406,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -428,8 +428,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - ictxt = desc_ar%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_ar%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -499,7 +499,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -522,7 +522,7 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 @@ -535,8 +535,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_zspins' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (nz < 0) then info = 1111 @@ -651,7 +651,7 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/base/tools/psb_zsprn.f90 b/base/tools/psb_zsprn.f90 index d7187f86..c1676bed 100644 --- a/base/tools/psb_zsprn.f90 +++ b/base/tools/psb_zsprn.f90 @@ -53,7 +53,7 @@ Subroutine psb_zsprn(a, desc_a,info,clear) logical, intent(in), optional :: clear !locals - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me,err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -65,8 +65,8 @@ Subroutine psb_zsprn(a, desc_a,info,clear) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start ' @@ -89,7 +89,7 @@ Subroutine psb_zsprn(a, desc_a,info,clear) call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_base_krylov_conv_mod.f90 b/krylov/psb_base_krylov_conv_mod.f90 index 292e86ac..be7723f5 100644 --- a/krylov/psb_base_krylov_conv_mod.f90 +++ b/krylov/psb_base_krylov_conv_mod.f90 @@ -146,7 +146,7 @@ contains real(psb_dpk_), optional, intent(out) :: err integer(psb_ipk_), optional, intent(out) :: iter - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act, itrace real(psb_dpk_) :: errnum, errden, eps character(len=20) :: name @@ -154,8 +154,8 @@ contains info = psb_success_ name = 'psb_end_conv' - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) errnum = stopdat%values(psb_ik_errnum_) errden = stopdat%values(psb_ik_errden_) diff --git a/krylov/psb_c_krylov_conv_mod.f90 b/krylov/psb_c_krylov_conv_mod.f90 index 20f96e28..85a2bca7 100644 --- a/krylov/psb_c_krylov_conv_mod.f90 +++ b/krylov/psb_c_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name complex(psb_spk_), allocatable :: r(:) @@ -71,9 +71,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = 0.0d0 @@ -117,7 +117,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -135,7 +135,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -143,8 +143,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) res = .false. @@ -195,7 +195,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -214,7 +214,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_c_vect_type) :: r @@ -224,9 +224,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = dzero @@ -270,7 +270,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -287,7 +287,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -297,8 +297,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) @@ -349,7 +349,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index 2f219782..c3b4f472 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -123,7 +123,7 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr @@ -137,8 +137,8 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np diff --git a/krylov/psb_ccg.F90 b/krylov/psb_ccg.F90 index 7c855926..fbc550e7 100644 --- a/krylov/psb_ccg.F90 +++ b/krylov/psb_ccg.F90 @@ -122,7 +122,7 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat @@ -136,9 +136,9 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index bf4de563..c25a449a 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -117,7 +117,7 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma @@ -132,8 +132,8 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_ccgstab.f90 b/krylov/psb_ccgstab.f90 index 06e6bb24..22d73b85 100644 --- a/krylov/psb_ccgstab.f90 +++ b/krylov/psb_ccgstab.f90 @@ -121,7 +121,7 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma, omega, tau @@ -135,8 +135,8 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index 2e829575..86ca5d93 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -134,7 +134,7 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me complex(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega @@ -149,8 +149,8 @@ Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_cfcg.F90 b/krylov/psb_cfcg.F90 index a90c4d67..00f55206 100644 --- a/krylov/psb_cfcg.F90 +++ b/krylov/psb_cfcg.F90 @@ -128,7 +128,7 @@ subroutine psb_cfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me complex(psb_spk_), allocatable, target :: aux(:) complex(psb_spk_) :: vres(3) @@ -143,9 +143,9 @@ subroutine psb_cfcg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -240,7 +240,7 @@ subroutine psb_cfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:2)) + call psb_sum(ctxt, vres(1:2)) alpha = vres(1) beta = vres(2) @@ -279,7 +279,7 @@ subroutine psb_cfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) vres(3) = psb_gedot(q, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:3)) + call psb_sum(ctxt, vres(1:3)) alpha = vres(1) beta = vres(2) diff --git a/krylov/psb_cgcr.f90 b/krylov/psb_cgcr.f90 index 82fb99c0..91c848a2 100644 --- a/krylov/psb_cgcr.f90 +++ b/krylov/psb_cgcr.f90 @@ -133,7 +133,7 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst complex(psb_spk_) :: hjj @@ -147,9 +147,9 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) diff --git a/krylov/psb_ckrylov.f90 b/krylov/psb_ckrylov.f90 index 67702e5e..01228234 100644 --- a/krylov/psb_ckrylov.f90 +++ b/krylov/psb_ckrylov.f90 @@ -152,7 +152,7 @@ Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_ckryl_cond_vect) :: psb_ccg_vect, psb_cfcg_vect logical :: do_alloc_wrk - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name @@ -160,9 +160,9 @@ Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& name = 'psb_krylov' call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! Default return for COND if (present(cond)) cond = szero @@ -220,7 +220,7 @@ Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index 1b062944..80aa34c3 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -137,7 +137,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me Real(psb_spk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr @@ -150,8 +150,8 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_d_krylov_conv_mod.f90 b/krylov/psb_d_krylov_conv_mod.f90 index d0890584..4f9b9f2e 100644 --- a/krylov/psb_d_krylov_conv_mod.f90 +++ b/krylov/psb_d_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name real(psb_dpk_), allocatable :: r(:) @@ -71,9 +71,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = 0.0d0 @@ -117,7 +117,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -135,7 +135,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -143,8 +143,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) res = .false. @@ -195,7 +195,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -214,7 +214,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_d_vect_type) :: r @@ -224,9 +224,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = dzero @@ -270,7 +270,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -287,7 +287,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -297,8 +297,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) @@ -349,7 +349,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index 3b81275b..5ac94d3c 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -123,7 +123,7 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr @@ -137,8 +137,8 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index 94678aac..669573be 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -122,7 +122,7 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat @@ -136,9 +136,9 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -310,7 +310,7 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& #endif info=psb_success_ end if - call psb_bcast(ictxt,cond) + call psb_bcast(ctxt,cond) end if diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index 0fa922d6..78a3905c 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -117,7 +117,7 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma @@ -132,8 +132,8 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_dcgstab.f90 b/krylov/psb_dcgstab.f90 index 27136ca2..bec3329a 100644 --- a/krylov/psb_dcgstab.f90 +++ b/krylov/psb_dcgstab.f90 @@ -121,7 +121,7 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau @@ -135,8 +135,8 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index 2e8a895b..01641226 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -134,7 +134,7 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega @@ -149,8 +149,8 @@ Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_dfcg.F90 b/krylov/psb_dfcg.F90 index 22e1f2ee..12c3b3dc 100644 --- a/krylov/psb_dfcg.F90 +++ b/krylov/psb_dfcg.F90 @@ -128,7 +128,7 @@ subroutine psb_dfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_), allocatable, target :: aux(:) real(psb_dpk_) :: vres(3) @@ -143,9 +143,9 @@ subroutine psb_dfcg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -240,7 +240,7 @@ subroutine psb_dfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:2)) + call psb_sum(ctxt, vres(1:2)) alpha = vres(1) beta = vres(2) @@ -279,7 +279,7 @@ subroutine psb_dfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) vres(3) = psb_gedot(q, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:3)) + call psb_sum(ctxt, vres(1:3)) alpha = vres(1) beta = vres(2) diff --git a/krylov/psb_dgcr.f90 b/krylov/psb_dgcr.f90 index 42c24b40..b7480f84 100644 --- a/krylov/psb_dgcr.f90 +++ b/krylov/psb_dgcr.f90 @@ -133,7 +133,7 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst real(psb_dpk_) :: hjj @@ -147,9 +147,9 @@ subroutine psb_dgcr_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) diff --git a/krylov/psb_dkrylov.f90 b/krylov/psb_dkrylov.f90 index 2beb922c..d5d40eaf 100644 --- a/krylov/psb_dkrylov.f90 +++ b/krylov/psb_dkrylov.f90 @@ -152,7 +152,7 @@ Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_dkryl_cond_vect) :: psb_dcg_vect, psb_dfcg_vect logical :: do_alloc_wrk - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name @@ -160,9 +160,9 @@ Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& name = 'psb_krylov' call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! Default return for COND if (present(cond)) cond = dzero @@ -220,7 +220,7 @@ Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index 0e2a3ef7..1503748a 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -137,7 +137,7 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me Real(psb_dpk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr @@ -150,8 +150,8 @@ subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_s_krylov_conv_mod.f90 b/krylov/psb_s_krylov_conv_mod.f90 index 19d84930..29713c37 100644 --- a/krylov/psb_s_krylov_conv_mod.f90 +++ b/krylov/psb_s_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name real(psb_spk_), allocatable :: r(:) @@ -71,9 +71,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = 0.0d0 @@ -117,7 +117,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -135,7 +135,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -143,8 +143,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) res = .false. @@ -195,7 +195,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -214,7 +214,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_s_vect_type) :: r @@ -224,9 +224,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = dzero @@ -270,7 +270,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -287,7 +287,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -297,8 +297,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) @@ -349,7 +349,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_sbicg.f90 b/krylov/psb_sbicg.f90 index ee2b0cf4..609d3a5f 100644 --- a/krylov/psb_sbicg.f90 +++ b/krylov/psb_sbicg.f90 @@ -123,7 +123,7 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_spk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr @@ -137,8 +137,8 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np diff --git a/krylov/psb_scg.F90 b/krylov/psb_scg.F90 index 2df33788..c16dbf6a 100644 --- a/krylov/psb_scg.F90 +++ b/krylov/psb_scg.F90 @@ -122,7 +122,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat @@ -136,9 +136,9 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -310,7 +310,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& #endif info=psb_success_ end if - call psb_bcast(ictxt,cond) + call psb_bcast(ctxt,cond) end if diff --git a/krylov/psb_scgs.f90 b/krylov/psb_scgs.f90 index 40095ff6..48fe5372 100644 --- a/krylov/psb_scgs.f90 +++ b/krylov/psb_scgs.f90 @@ -117,7 +117,7 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit real(psb_spk_) :: alpha, beta, rho, rho_old, sigma @@ -132,8 +132,8 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_scgstab.f90 b/krylov/psb_scgstab.f90 index ecb1de1b..2a811b8d 100644 --- a/krylov/psb_scgstab.f90 +++ b/krylov/psb_scgstab.f90 @@ -121,7 +121,7 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr real(psb_spk_) :: alpha, beta, rho, rho_old, sigma, omega, tau @@ -135,8 +135,8 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_scgstabl.f90 b/krylov/psb_scgstabl.f90 index ea5d26b1..c2fc9833 100644 --- a/krylov/psb_scgstabl.f90 +++ b/krylov/psb_scgstabl.f90 @@ -134,7 +134,7 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega @@ -149,8 +149,8 @@ Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_sfcg.F90 b/krylov/psb_sfcg.F90 index 67685c98..dc770ce6 100644 --- a/krylov/psb_sfcg.F90 +++ b/krylov/psb_sfcg.F90 @@ -128,7 +128,7 @@ subroutine psb_sfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_spk_), allocatable, target :: aux(:) real(psb_spk_) :: vres(3) @@ -143,9 +143,9 @@ subroutine psb_sfcg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -240,7 +240,7 @@ subroutine psb_sfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:2)) + call psb_sum(ctxt, vres(1:2)) alpha = vres(1) beta = vres(2) @@ -279,7 +279,7 @@ subroutine psb_sfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) vres(3) = psb_gedot(q, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:3)) + call psb_sum(ctxt, vres(1:3)) alpha = vres(1) beta = vres(2) diff --git a/krylov/psb_sgcr.f90 b/krylov/psb_sgcr.f90 index b26cf80e..dd0aca16 100644 --- a/krylov/psb_sgcr.f90 +++ b/krylov/psb_sgcr.f90 @@ -133,7 +133,7 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst real(psb_spk_) :: hjj @@ -147,9 +147,9 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) diff --git a/krylov/psb_skrylov.f90 b/krylov/psb_skrylov.f90 index 38a1ae77..39aecc36 100644 --- a/krylov/psb_skrylov.f90 +++ b/krylov/psb_skrylov.f90 @@ -152,7 +152,7 @@ Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_skryl_cond_vect) :: psb_scg_vect, psb_sfcg_vect logical :: do_alloc_wrk - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name @@ -160,9 +160,9 @@ Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& name = 'psb_krylov' call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! Default return for COND if (present(cond)) cond = szero @@ -220,7 +220,7 @@ Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index b7ae8d08..02836dd7 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -137,7 +137,7 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me Real(psb_spk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr @@ -150,8 +150,8 @@ subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_z_krylov_conv_mod.f90 b/krylov/psb_z_krylov_conv_mod.f90 index af236e54..fc88ccf6 100644 --- a/krylov/psb_z_krylov_conv_mod.f90 +++ b/krylov/psb_z_krylov_conv_mod.f90 @@ -61,7 +61,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name complex(psb_dpk_), allocatable :: r(:) @@ -71,9 +71,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = 0.0d0 @@ -117,7 +117,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -135,7 +135,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -143,8 +143,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) res = .false. @@ -195,7 +195,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -214,7 +214,7 @@ contains type(psb_itconv_type) :: stopdat integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name type(psb_z_vect_type) :: r @@ -224,9 +224,9 @@ contains call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) stopdat%controls(:) = 0 stopdat%values(:) = dzero @@ -270,7 +270,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -287,7 +287,7 @@ contains logical :: res integer(psb_ipk_), intent(out) :: info - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me, np, err_act character(len=20) :: name @@ -297,8 +297,8 @@ contains name = 'psb_check_conv' call psb_erractionsave(err_act) - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) @@ -349,7 +349,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_zbicg.f90 b/krylov/psb_zbicg.f90 index 223e6998..c22e499a 100644 --- a/krylov/psb_zbicg.f90 +++ b/krylov/psb_zbicg.f90 @@ -123,7 +123,7 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& logical, parameter :: exchange=.true., noexchange=.false. integer(psb_ipk_), parameter :: irmax = 8 integer(psb_ipk_) :: itx - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma real(psb_dpk_) :: derr @@ -137,8 +137,8 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np diff --git a/krylov/psb_zcg.F90 b/krylov/psb_zcg.F90 index 66f3fdbe..a4a521d8 100644 --- a/krylov/psb_zcg.F90 +++ b/krylov/psb_zcg.F90 @@ -122,7 +122,7 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& & n_col, n_row,err_act, ieg,nspl, istebz integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr type(psb_itconv_type) :: stopdat @@ -136,9 +136,9 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index 2a245980..3ccce860 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -117,7 +117,7 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: itmax_, naux, it, itrace_,& & n_row, n_col,istop_, itx, err_act integer(psb_lpk_) :: mglob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: debug_level, debug_unit complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma @@ -132,8 +132,8 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/krylov/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 index e6060d1b..95ff129a 100644 --- a/krylov/psb_zcgstab.f90 +++ b/krylov/psb_zcgstab.f90 @@ -121,7 +121,7 @@ Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, err_act, i integer(psb_ipk_) :: istop_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me real(psb_dpk_) :: derr complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau @@ -135,8 +135,8 @@ Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_zcgstabl.f90 b/krylov/psb_zcgstabl.f90 index e2421e98..2cf3a0e5 100644 --- a/krylov/psb_zcgstabl.f90 +++ b/krylov/psb_zcgstabl.f90 @@ -134,7 +134,7 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_,j, k integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me complex(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& & omega @@ -149,8 +149,8 @@ Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(x%v)) then diff --git a/krylov/psb_zfcg.F90 b/krylov/psb_zfcg.F90 index 21f1d3cb..a9eb24b7 100644 --- a/krylov/psb_zfcg.F90 +++ b/krylov/psb_zfcg.F90 @@ -128,7 +128,7 @@ subroutine psb_zfcg_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me complex(psb_dpk_), allocatable, target :: aux(:) complex(psb_dpk_) :: vres(3) @@ -143,9 +143,9 @@ subroutine psb_zfcg_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -240,7 +240,7 @@ subroutine psb_zfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:2)) + call psb_sum(ctxt, vres(1:2)) alpha = vres(1) beta = vres(2) @@ -279,7 +279,7 @@ subroutine psb_zfcg_vect(a,prec,b,x,eps,desc_a,info,& vres(2) = psb_gedot(w, v, desc_a, info, global = .false.) vres(3) = psb_gedot(q, v, desc_a, info, global = .false.) - call psb_sum(ictxt, vres(1:3)) + call psb_sum(ctxt, vres(1:3)) alpha = vres(1) beta = vres(2) diff --git a/krylov/psb_zgcr.f90 b/krylov/psb_zgcr.f90 index a8a05268..2399160c 100644 --- a/krylov/psb_zgcr.f90 +++ b/krylov/psb_zgcr.f90 @@ -133,7 +133,7 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_) :: n_col, naux, err_act integer(psb_lpk_) :: mglob integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me integer(psb_ipk_) :: i, j, it, itx, istop_, itmax_, itrace_, nl, m, nrst complex(psb_dpk_) :: hjj @@ -147,9 +147,9 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) if (.not.allocated(b%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) diff --git a/krylov/psb_zkrylov.f90 b/krylov/psb_zkrylov.f90 index 34344407..a70cc98a 100644 --- a/krylov/psb_zkrylov.f90 +++ b/krylov/psb_zkrylov.f90 @@ -152,7 +152,7 @@ Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& procedure(psb_zkryl_cond_vect) :: psb_zcg_vect, psb_zfcg_vect logical :: do_alloc_wrk - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np,err_act, itrace_ character(len=20) :: name @@ -160,9 +160,9 @@ Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& name = 'psb_krylov' call psb_erractionsave(err_act) - ictxt=desc_a%get_context() + ctxt=desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) ! Default return for COND if (present(cond)) cond = dzero @@ -220,7 +220,7 @@ Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index fefefa5e..3aaf0032 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -137,7 +137,7 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& integer(psb_ipk_), Parameter :: irmax = 8 integer(psb_ipk_) :: itx, i, istop_, err_act integer(psb_ipk_) :: debug_level, debug_unit - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me Real(psb_dpk_) :: rni, xni, bni, ani,bn2, dt, r0n2 real(psb_dpk_) :: errnum, errden, deps, derr @@ -150,8 +150,8 @@ subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%get_context() - Call psb_info(ictxt, me, np) + ctxt = desc_a%get_context() + Call psb_info(ctxt, me, np) if (debug_level >= psb_debug_ext_)& & write(debug_unit,*) me,' ',trim(name),': from psb_info',np if (.not.allocated(b%v)) then diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index de0a57e5..dbd890c7 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_c_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_c_bjac_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) @@ -88,7 +88,7 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:) type(psb_c_vect_type) :: wv, wv1 - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -101,8 +101,8 @@ subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -244,7 +244,7 @@ subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -256,8 +256,8 @@ subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -435,7 +435,7 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_c_csr_sparse_mat), allocatable :: lf, uf complex(psb_spk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me character(len=20) :: name='c_bjac_precbld' character(len=20) :: ch_err @@ -448,9 +448,9 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_ctxt() - call prec%set_ctxt(ictxt) - call psb_info(ictxt, me, np) + ctxt=desc_a%get_ctxt() + call prec%set_ctxt(ctxt) + call psb_info(ctxt, me, np) m = a%get_nrows() if (m < 0) then diff --git a/prec/impl/psb_c_diagprec_impl.f90 b/prec/impl/psb_c_diagprec_impl.f90 index 6ad7586d..0b20c7ef 100644 --- a/prec/impl/psb_c_diagprec_impl.f90 +++ b/prec/impl/psb_c_diagprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_c_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_c_diag_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/impl/psb_c_prec_type_impl.f90 b/prec/impl/psb_c_prec_type_impl.f90 index 5858df0b..81a139ea 100644 --- a/prec/impl/psb_c_prec_type_impl.f90 +++ b/prec/impl/psb_c_prec_type_impl.f90 @@ -76,7 +76,7 @@ subroutine psb_c_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_spk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -85,8 +85,8 @@ subroutine psb_c_apply2_vect(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -147,7 +147,7 @@ subroutine psb_c_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_c_vect_type) :: ww character :: trans_ complex(psb_spk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -156,8 +156,8 @@ subroutine psb_c_apply1_vect(prec,x,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -220,7 +220,7 @@ subroutine psb_c_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_spk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -229,8 +229,8 @@ subroutine psb_c_apply2v(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=trans @@ -285,7 +285,7 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act complex(psb_spk_), pointer :: WW(:), w1(:) @@ -295,8 +295,8 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) else diff --git a/prec/impl/psb_cprecbld.f90 b/prec/impl/psb_cprecbld.f90 index 39d16bd8..3c3bf8be 100644 --- a/prec/impl/psb_cprecbld.f90 +++ b/prec/impl/psb_cprecbld.f90 @@ -44,7 +44,7 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 @@ -59,9 +59,9 @@ subroutine psb_cprecbld(a,desc_a,p,info,amold,vmold,imold) end if info = psb_success_ - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() diff --git a/prec/impl/psb_cprecinit.f90 b/prec/impl/psb_cprecinit.f90 index ace7fea3..63b4d51b 100644 --- a/prec/impl/psb_cprecinit.f90 +++ b/prec/impl/psb_cprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_cprecinit(ictxt,p,ptype,info) +subroutine psb_cprecinit(ctxt,p,ptype,info) use psb_base_mod use psb_c_prec_type, psb_protect_name => psb_cprecinit @@ -37,7 +37,7 @@ subroutine psb_cprecinit(ictxt,p,ptype,info) use psb_c_diagprec, only : psb_c_diag_prec_type use psb_c_bjacprec, only : psb_c_bjac_prec_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_cprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -50,7 +50,7 @@ subroutine psb_cprecinit(ictxt,p,ptype,info) if (info /= psb_success_) return end if - p%ictxt = ictxt + p%ctxt = ctxt select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index b8643385..08409346 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_d_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_d_bjac_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) @@ -88,7 +88,7 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:) type(psb_d_vect_type) :: wv, wv1 - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -101,8 +101,8 @@ subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -244,7 +244,7 @@ subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -256,8 +256,8 @@ subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -435,7 +435,7 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_d_csr_sparse_mat), allocatable :: lf, uf real(psb_dpk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me character(len=20) :: name='d_bjac_precbld' character(len=20) :: ch_err @@ -448,9 +448,9 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_ctxt() - call prec%set_ctxt(ictxt) - call psb_info(ictxt, me, np) + ctxt=desc_a%get_ctxt() + call prec%set_ctxt(ctxt) + call psb_info(ctxt, me, np) m = a%get_nrows() if (m < 0) then diff --git a/prec/impl/psb_d_diagprec_impl.f90 b/prec/impl/psb_d_diagprec_impl.f90 index 4c0d4937..8c7e560c 100644 --- a/prec/impl/psb_d_diagprec_impl.f90 +++ b/prec/impl/psb_d_diagprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_d_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_d_diag_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/impl/psb_d_prec_type_impl.f90 b/prec/impl/psb_d_prec_type_impl.f90 index 2dead542..49b5bcf2 100644 --- a/prec/impl/psb_d_prec_type_impl.f90 +++ b/prec/impl/psb_d_prec_type_impl.f90 @@ -76,7 +76,7 @@ subroutine psb_d_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_dpk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -85,8 +85,8 @@ subroutine psb_d_apply2_vect(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -147,7 +147,7 @@ subroutine psb_d_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_d_vect_type) :: ww character :: trans_ real(psb_dpk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -156,8 +156,8 @@ subroutine psb_d_apply1_vect(prec,x,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -220,7 +220,7 @@ subroutine psb_d_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_dpk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -229,8 +229,8 @@ subroutine psb_d_apply2v(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=trans @@ -285,7 +285,7 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act real(psb_dpk_), pointer :: WW(:), w1(:) @@ -295,8 +295,8 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) else diff --git a/prec/impl/psb_dprecbld.f90 b/prec/impl/psb_dprecbld.f90 index f3cef96a..c37a05e9 100644 --- a/prec/impl/psb_dprecbld.f90 +++ b/prec/impl/psb_dprecbld.f90 @@ -44,7 +44,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 @@ -59,9 +59,9 @@ subroutine psb_dprecbld(a,desc_a,p,info,amold,vmold,imold) end if info = psb_success_ - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() diff --git a/prec/impl/psb_dprecinit.f90 b/prec/impl/psb_dprecinit.f90 index 771a1c21..260a4f51 100644 --- a/prec/impl/psb_dprecinit.f90 +++ b/prec/impl/psb_dprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_dprecinit(ictxt,p,ptype,info) +subroutine psb_dprecinit(ctxt,p,ptype,info) use psb_base_mod use psb_d_prec_type, psb_protect_name => psb_dprecinit @@ -37,7 +37,7 @@ subroutine psb_dprecinit(ictxt,p,ptype,info) use psb_d_diagprec, only : psb_d_diag_prec_type use psb_d_bjacprec, only : psb_d_bjac_prec_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_dprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -50,7 +50,7 @@ subroutine psb_dprecinit(ictxt,p,ptype,info) if (info /= psb_success_) return end if - p%ictxt = ictxt + p%ctxt = ctxt select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index 7903eda0..72ac6048 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_s_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_s_bjac_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) @@ -88,7 +88,7 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:) type(psb_s_vect_type) :: wv, wv1 - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -101,8 +101,8 @@ subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -244,7 +244,7 @@ subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -256,8 +256,8 @@ subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -435,7 +435,7 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_s_csr_sparse_mat), allocatable :: lf, uf real(psb_spk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me character(len=20) :: name='s_bjac_precbld' character(len=20) :: ch_err @@ -448,9 +448,9 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_ctxt() - call prec%set_ctxt(ictxt) - call psb_info(ictxt, me, np) + ctxt=desc_a%get_ctxt() + call prec%set_ctxt(ctxt) + call psb_info(ctxt, me, np) m = a%get_nrows() if (m < 0) then diff --git a/prec/impl/psb_s_diagprec_impl.f90 b/prec/impl/psb_s_diagprec_impl.f90 index b463bfdb..29e2e1a7 100644 --- a/prec/impl/psb_s_diagprec_impl.f90 +++ b/prec/impl/psb_s_diagprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_s_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_s_diag_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/impl/psb_s_prec_type_impl.f90 b/prec/impl/psb_s_prec_type_impl.f90 index 36e0ccbc..4379322b 100644 --- a/prec/impl/psb_s_prec_type_impl.f90 +++ b/prec/impl/psb_s_prec_type_impl.f90 @@ -76,7 +76,7 @@ subroutine psb_s_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_spk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -85,8 +85,8 @@ subroutine psb_s_apply2_vect(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -147,7 +147,7 @@ subroutine psb_s_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_s_vect_type) :: ww character :: trans_ real(psb_spk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -156,8 +156,8 @@ subroutine psb_s_apply1_vect(prec,x,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -220,7 +220,7 @@ subroutine psb_s_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ real(psb_spk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -229,8 +229,8 @@ subroutine psb_s_apply2v(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=trans @@ -285,7 +285,7 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act real(psb_spk_), pointer :: WW(:), w1(:) @@ -295,8 +295,8 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) else diff --git a/prec/impl/psb_sprecbld.f90 b/prec/impl/psb_sprecbld.f90 index 7e67fe05..a878c16c 100644 --- a/prec/impl/psb_sprecbld.f90 +++ b/prec/impl/psb_sprecbld.f90 @@ -44,7 +44,7 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 @@ -59,9 +59,9 @@ subroutine psb_sprecbld(a,desc_a,p,info,amold,vmold,imold) end if info = psb_success_ - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() diff --git a/prec/impl/psb_sprecinit.f90 b/prec/impl/psb_sprecinit.f90 index b7924628..32641bbb 100644 --- a/prec/impl/psb_sprecinit.f90 +++ b/prec/impl/psb_sprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_sprecinit(ictxt,p,ptype,info) +subroutine psb_sprecinit(ctxt,p,ptype,info) use psb_base_mod use psb_s_prec_type, psb_protect_name => psb_sprecinit @@ -37,7 +37,7 @@ subroutine psb_sprecinit(ictxt,p,ptype,info) use psb_s_diagprec, only : psb_s_diag_prec_type use psb_s_bjacprec, only : psb_s_bjac_prec_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_sprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -50,7 +50,7 @@ subroutine psb_sprecinit(ictxt,p,ptype,info) if (info /= psb_success_) return end if - p%ictxt = ictxt + p%ctxt = ctxt select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index e0265ecb..70e062a5 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_z_bjac_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_z_bjac_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) @@ -88,7 +88,7 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:) type(psb_z_vect_type) :: wv, wv1 - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -101,8 +101,8 @@ subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -244,7 +244,7 @@ subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) ! Local variables integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act, ierr(5) integer(psb_ipk_) :: debug_level, debug_unit @@ -256,8 +256,8 @@ subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) trans_ = psb_toupper(trans) @@ -435,7 +435,7 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) type(psb_z_csr_sparse_mat), allocatable :: lf, uf complex(psb_dpk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me character(len=20) :: name='z_bjac_precbld' character(len=20) :: ch_err @@ -448,9 +448,9 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) info = psb_err_internal_error_ ; goto 9999 end if - ictxt=desc_a%get_ctxt() - call prec%set_ctxt(ictxt) - call psb_info(ictxt, me, np) + ctxt=desc_a%get_ctxt() + call prec%set_ctxt(ctxt) + call psb_info(ctxt, me, np) m = a%get_nrows() if (m < 0) then diff --git a/prec/impl/psb_z_diagprec_impl.f90 b/prec/impl/psb_z_diagprec_impl.f90 index a70d6492..7a20006a 100644 --- a/prec/impl/psb_z_diagprec_impl.f90 +++ b/prec/impl/psb_z_diagprec_impl.f90 @@ -38,7 +38,7 @@ subroutine psb_z_diag_dump(prec,info,prefix,head) integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head integer(psb_ipk_) :: i, j, il1, iln, lname, lev - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than @@ -46,8 +46,8 @@ subroutine psb_z_diag_dump(prec,info,prefix,head) ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/impl/psb_z_prec_type_impl.f90 b/prec/impl/psb_z_prec_type_impl.f90 index 8b25f94e..9cbd32ca 100644 --- a/prec/impl/psb_z_prec_type_impl.f90 +++ b/prec/impl/psb_z_prec_type_impl.f90 @@ -76,7 +76,7 @@ subroutine psb_z_apply2_vect(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_dpk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -85,8 +85,8 @@ subroutine psb_z_apply2_vect(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -147,7 +147,7 @@ subroutine psb_z_apply1_vect(prec,x,desc_data,info,trans,work) type(psb_z_vect_type) :: ww character :: trans_ complex(psb_dpk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -156,8 +156,8 @@ subroutine psb_z_apply1_vect(prec,x,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) @@ -220,7 +220,7 @@ subroutine psb_z_apply2v(prec,x,y,desc_data,info,trans,work) character :: trans_ complex(psb_dpk_), pointer :: work_(:) - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act character(len=20) :: name @@ -229,8 +229,8 @@ subroutine psb_z_apply2v(prec,x,y,desc_data,info,trans,work) info = psb_success_ call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=trans @@ -285,7 +285,7 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans) character(len=1), optional :: trans character :: trans_ - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np,me integer(psb_ipk_) :: err_act complex(psb_dpk_), pointer :: WW(:), w1(:) @@ -295,8 +295,8 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans) call psb_erractionsave(err_act) - ictxt = desc_data%get_context() - call psb_info(ictxt, me, np) + ctxt = desc_data%get_context() + call psb_info(ctxt, me, np) if (present(trans)) then trans_=psb_toupper(trans) else diff --git a/prec/impl/psb_zprecbld.f90 b/prec/impl/psb_zprecbld.f90 index dbe33611..3c584947 100644 --- a/prec/impl/psb_zprecbld.f90 +++ b/prec/impl/psb_zprecbld.f90 @@ -44,7 +44,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold) class(psb_i_base_vect_type), intent(in), optional :: imold ! Local scalars - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: me,np integer(psb_ipk_) :: err, n_row, n_col,mglob, err_act integer(psb_ipk_),parameter :: iroot=psb_root_,iout=60,ilout=40 @@ -59,9 +59,9 @@ subroutine psb_zprecbld(a,desc_a,p,info,amold,vmold,imold) end if info = psb_success_ - ictxt = desc_a%get_context() + ctxt = desc_a%get_context() - call psb_info(ictxt, me, np) + call psb_info(ctxt, me, np) n_row = desc_a%get_local_rows() n_col = desc_a%get_local_cols() diff --git a/prec/impl/psb_zprecinit.f90 b/prec/impl/psb_zprecinit.f90 index 5f9556d3..167a43ec 100644 --- a/prec/impl/psb_zprecinit.f90 +++ b/prec/impl/psb_zprecinit.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_zprecinit(ictxt,p,ptype,info) +subroutine psb_zprecinit(ctxt,p,ptype,info) use psb_base_mod use psb_z_prec_type, psb_protect_name => psb_zprecinit @@ -37,7 +37,7 @@ subroutine psb_zprecinit(ictxt,p,ptype,info) use psb_z_diagprec, only : psb_z_diag_prec_type use psb_z_bjacprec, only : psb_z_bjac_prec_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_zprec_type), intent(inout) :: p character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info @@ -50,7 +50,7 @@ subroutine psb_zprecinit(ictxt,p,ptype,info) if (info /= psb_success_) return end if - p%ictxt = ictxt + p%ctxt = ctxt select case(psb_toupper(ptype(1:len_trim(ptype)))) case ('NONE','NOPREC') diff --git a/prec/psb_c_base_prec_mod.f90 b/prec/psb_c_base_prec_mod.f90 index 62c997aa..85dccc3a 100644 --- a/prec/psb_c_base_prec_mod.f90 +++ b/prec/psb_c_base_prec_mod.f90 @@ -47,7 +47,7 @@ module psb_c_base_prec_mod use psb_prec_const_mod type, abstract :: psb_c_base_prec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt contains procedure, pass(prec) :: set_ctxt => psb_c_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_c_base_get_ctxt @@ -343,12 +343,12 @@ contains end function psb_c_base_is_allocated_wrk - subroutine psb_c_base_set_ctxt(prec,ictxt) + subroutine psb_c_base_set_ctxt(prec,ctxt) implicit none class(psb_c_base_prec_type), intent(inout) :: prec - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt - prec%ictxt = ictxt + prec%ctxt = ctxt end subroutine psb_c_base_set_ctxt @@ -364,7 +364,7 @@ contains class(psb_c_base_prec_type), intent(in) :: prec type(psb_ctxt_type) :: val - val = prec%ictxt + val = prec%ctxt return end function psb_c_base_get_ctxt @@ -383,11 +383,11 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: ni, iam, np - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) res = '' if (iam /= psb_root_) then diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index 67cee500..6526ac31 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -148,7 +148,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='c_bjac_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -172,8 +172,8 @@ contains goto 9999 end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam if (iam == root_) & diff --git a/prec/psb_c_diagprec.f90 b/prec/psb_c_diagprec.f90 index cedcf0c4..c3deb6d8 100644 --- a/prec/psb_c_diagprec.f90 +++ b/prec/psb_c_diagprec.f90 @@ -171,7 +171,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='c_diag_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -189,8 +189,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam diff --git a/prec/psb_c_nullprec.f90 b/prec/psb_c_nullprec.f90 index 7130679a..ac23a3db 100644 --- a/prec/psb_c_nullprec.f90 +++ b/prec/psb_c_nullprec.f90 @@ -170,7 +170,7 @@ contains character(len=20) :: name='c_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -188,8 +188,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam @@ -213,7 +213,7 @@ contains class(psb_c_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ @@ -222,8 +222,8 @@ contains ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 4314b672..cd5e64e4 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -39,7 +39,7 @@ module psb_c_prec_type use psb_c_base_prec_mod type psb_cprec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt class(psb_c_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_c_apply1_vect @@ -64,10 +64,10 @@ module psb_c_prec_type end interface interface psb_precinit - subroutine psb_cprecinit(ictxt,prec,ptype,info) + subroutine psb_cprecinit(ctxt,prec,ptype,info) import :: psb_ipk_, psb_cprec_type, psb_ctxt_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_cprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_d_base_prec_mod.f90 b/prec/psb_d_base_prec_mod.f90 index 59689197..74b28f02 100644 --- a/prec/psb_d_base_prec_mod.f90 +++ b/prec/psb_d_base_prec_mod.f90 @@ -47,7 +47,7 @@ module psb_d_base_prec_mod use psb_prec_const_mod type, abstract :: psb_d_base_prec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt contains procedure, pass(prec) :: set_ctxt => psb_d_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_d_base_get_ctxt @@ -343,12 +343,12 @@ contains end function psb_d_base_is_allocated_wrk - subroutine psb_d_base_set_ctxt(prec,ictxt) + subroutine psb_d_base_set_ctxt(prec,ctxt) implicit none class(psb_d_base_prec_type), intent(inout) :: prec - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt - prec%ictxt = ictxt + prec%ctxt = ctxt end subroutine psb_d_base_set_ctxt @@ -364,7 +364,7 @@ contains class(psb_d_base_prec_type), intent(in) :: prec type(psb_ctxt_type) :: val - val = prec%ictxt + val = prec%ctxt return end function psb_d_base_get_ctxt @@ -383,11 +383,11 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: ni, iam, np - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) res = '' if (iam /= psb_root_) then diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 1ca350ce..bba4d686 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -148,7 +148,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='d_bjac_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -172,8 +172,8 @@ contains goto 9999 end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam if (iam == root_) & diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index 36e49247..7ebcb6c3 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -171,7 +171,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='d_diag_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -189,8 +189,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam diff --git a/prec/psb_d_nullprec.f90 b/prec/psb_d_nullprec.f90 index 4b8f22a5..65214a31 100644 --- a/prec/psb_d_nullprec.f90 +++ b/prec/psb_d_nullprec.f90 @@ -170,7 +170,7 @@ contains character(len=20) :: name='d_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -188,8 +188,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam @@ -213,7 +213,7 @@ contains class(psb_d_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ @@ -222,8 +222,8 @@ contains ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index 322fade3..6ba9d3be 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -39,7 +39,7 @@ module psb_d_prec_type use psb_d_base_prec_mod type psb_dprec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt class(psb_d_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_d_apply1_vect @@ -64,10 +64,10 @@ module psb_d_prec_type end interface interface psb_precinit - subroutine psb_dprecinit(ictxt,prec,ptype,info) + subroutine psb_dprecinit(ctxt,prec,ptype,info) import :: psb_ipk_, psb_dprec_type, psb_ctxt_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_dprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_s_base_prec_mod.f90 b/prec/psb_s_base_prec_mod.f90 index 35bcc785..e41690f0 100644 --- a/prec/psb_s_base_prec_mod.f90 +++ b/prec/psb_s_base_prec_mod.f90 @@ -47,7 +47,7 @@ module psb_s_base_prec_mod use psb_prec_const_mod type, abstract :: psb_s_base_prec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt contains procedure, pass(prec) :: set_ctxt => psb_s_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_s_base_get_ctxt @@ -343,12 +343,12 @@ contains end function psb_s_base_is_allocated_wrk - subroutine psb_s_base_set_ctxt(prec,ictxt) + subroutine psb_s_base_set_ctxt(prec,ctxt) implicit none class(psb_s_base_prec_type), intent(inout) :: prec - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt - prec%ictxt = ictxt + prec%ctxt = ctxt end subroutine psb_s_base_set_ctxt @@ -364,7 +364,7 @@ contains class(psb_s_base_prec_type), intent(in) :: prec type(psb_ctxt_type) :: val - val = prec%ictxt + val = prec%ctxt return end function psb_s_base_get_ctxt @@ -383,11 +383,11 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: ni, iam, np - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) res = '' if (iam /= psb_root_) then diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 6d404d47..3e757f6b 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -148,7 +148,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='s_bjac_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -172,8 +172,8 @@ contains goto 9999 end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam if (iam == root_) & diff --git a/prec/psb_s_diagprec.f90 b/prec/psb_s_diagprec.f90 index 6807ae48..c5af4dd1 100644 --- a/prec/psb_s_diagprec.f90 +++ b/prec/psb_s_diagprec.f90 @@ -171,7 +171,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='s_diag_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -189,8 +189,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam diff --git a/prec/psb_s_nullprec.f90 b/prec/psb_s_nullprec.f90 index c7ad6ee9..33b22de0 100644 --- a/prec/psb_s_nullprec.f90 +++ b/prec/psb_s_nullprec.f90 @@ -170,7 +170,7 @@ contains character(len=20) :: name='s_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -188,8 +188,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam @@ -213,7 +213,7 @@ contains class(psb_s_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ @@ -222,8 +222,8 @@ contains ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index b59e71a5..b6c43c8a 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -39,7 +39,7 @@ module psb_s_prec_type use psb_s_base_prec_mod type psb_sprec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt class(psb_s_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_s_apply1_vect @@ -64,10 +64,10 @@ module psb_s_prec_type end interface interface psb_precinit - subroutine psb_sprecinit(ictxt,prec,ptype,info) + subroutine psb_sprecinit(ctxt,prec,ptype,info) import :: psb_ipk_, psb_sprec_type, psb_ctxt_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_sprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/prec/psb_z_base_prec_mod.f90 b/prec/psb_z_base_prec_mod.f90 index 79c185a3..740d3219 100644 --- a/prec/psb_z_base_prec_mod.f90 +++ b/prec/psb_z_base_prec_mod.f90 @@ -47,7 +47,7 @@ module psb_z_base_prec_mod use psb_prec_const_mod type, abstract :: psb_z_base_prec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt contains procedure, pass(prec) :: set_ctxt => psb_z_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_z_base_get_ctxt @@ -343,12 +343,12 @@ contains end function psb_z_base_is_allocated_wrk - subroutine psb_z_base_set_ctxt(prec,ictxt) + subroutine psb_z_base_set_ctxt(prec,ctxt) implicit none class(psb_z_base_prec_type), intent(inout) :: prec - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt - prec%ictxt = ictxt + prec%ctxt = ctxt end subroutine psb_z_base_set_ctxt @@ -364,7 +364,7 @@ contains class(psb_z_base_prec_type), intent(in) :: prec type(psb_ctxt_type) :: val - val = prec%ictxt + val = prec%ctxt return end function psb_z_base_get_ctxt @@ -383,11 +383,11 @@ contains character(len=32) :: res ! character(len=32) :: frmtv - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: ni, iam, np - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) res = '' if (iam /= psb_root_) then diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index 853358fe..97751de8 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -148,7 +148,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='z_bjac_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -172,8 +172,8 @@ contains goto 9999 end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam if (iam == root_) & diff --git a/prec/psb_z_diagprec.f90 b/prec/psb_z_diagprec.f90 index 957d6357..f62f4c03 100644 --- a/prec/psb_z_diagprec.f90 +++ b/prec/psb_z_diagprec.f90 @@ -171,7 +171,7 @@ contains integer(psb_ipk_) :: err_act, nrow, info character(len=20) :: name='z_diag_precdescr' - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -189,8 +189,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam diff --git a/prec/psb_z_nullprec.f90 b/prec/psb_z_nullprec.f90 index 9343bcc2..4981ef21 100644 --- a/prec/psb_z_nullprec.f90 +++ b/prec/psb_z_nullprec.f90 @@ -170,7 +170,7 @@ contains character(len=20) :: name='z_null_precset' character(len=32) :: dprefix, frmtv integer(psb_ipk_) :: ni - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout_, iam, np, root_ call psb_erractionsave(err_act) @@ -188,8 +188,8 @@ contains root_ = psb_root_ end if - ictxt = prec%ictxt - call psb_info(ictxt,iam,np) + ctxt = prec%ctxt + call psb_info(ctxt,iam,np) if (root_ == -1) root_ = iam @@ -213,7 +213,7 @@ contains class(psb_z_null_prec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix,head - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iout, iam, np, lname logical :: isopen character(len=80) :: prefix_ @@ -222,8 +222,8 @@ contains ! len of prefix_ info = 0 - ictxt = prec%get_ctxt() - call psb_info(ictxt,iam,np) + ctxt = prec%get_ctxt() + call psb_info(ctxt,iam,np) if (present(prefix)) then prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index 48243b29..7b15c8f2 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -39,7 +39,7 @@ module psb_z_prec_type use psb_z_base_prec_mod type psb_zprec_type - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt class(psb_z_base_prec_type), allocatable :: prec contains procedure, pass(prec) :: psb_z_apply1_vect @@ -64,10 +64,10 @@ module psb_z_prec_type end interface interface psb_precinit - subroutine psb_zprecinit(ictxt,prec,ptype,info) + subroutine psb_zprecinit(ctxt,prec,ptype,info) import :: psb_ipk_, psb_zprec_type, psb_ctxt_type implicit none - type(psb_ctxt_type), intent(in) :: ictxt + type(psb_ctxt_type), intent(in) :: ctxt class(psb_zprec_type), intent(inout) :: prec character(len=*), intent(in) :: ptype integer(psb_ipk_), intent(out) :: info diff --git a/test/cdasb/psb_d_pde3d.f90 b/test/cdasb/psb_d_pde3d.f90 index fa23602f..f554bd8a 100644 --- a/test/cdasb/psb_d_pde3d.f90 +++ b/test/cdasb/psb_d_pde3d.f90 @@ -168,7 +168,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + subroutine psb_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod @@ -192,7 +192,7 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f @@ -236,7 +236,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) call psb_cd_set_large_threshold(1000) call psb_cd_set_maxspace(10000) @@ -283,12 +283,12 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -296,7 +296,7 @@ contains ! First example of use of CDALL: specify for each process a number of ! contiguous rows ! - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -307,15 +307,15 @@ contains if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -323,7 +323,7 @@ contains ! Second example of use of CDALL: specify for each row the ! process that owns it ! - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -365,15 +365,15 @@ contains write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& & nr,nlr,mynx,myny,mynz info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) end if ! ! Third example of use of CDALL: specify for each process ! the set of global indices it owns. ! - call psb_cdall(ictxt,desc_a,info,vl=myidx) + call psb_cdall(ctxt,desc_a,info,vl=myidx) block @@ -420,8 +420,8 @@ contains case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end select @@ -431,7 +431,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -457,7 +457,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -558,11 +558,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -571,7 +571,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -587,13 +587,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -608,7 +608,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_gen_pde3d @@ -642,7 +642,7 @@ program psb_d_pde3d ! dense vectors type(psb_d_vect_type) :: xxv,bv ! parallel environment - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -658,12 +658,12 @@ program psb_d_pde3d info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_errstatus_fatal()) goto 9999 @@ -679,15 +679,15 @@ program psb_d_pde3d ! ! get parameters ! - call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + call get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) - call psb_barrier(ictxt) + call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -712,10 +712,10 @@ program psb_d_pde3d goto 9999 end if - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -723,15 +723,15 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + type(psb_ctxt_type) :: ctxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == 0) then if (command_argument_count()>0) then @@ -740,7 +740,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -801,7 +801,7 @@ contains else ! wrong number of parameter, print an error message and exit call pr_usage(izero) - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 endif if (inp_unit /= psb_inp_unit) then @@ -810,15 +810,15 @@ contains end if ! broadcast parameters to all processors - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,idim) - call psb_bcast(ictxt,ipart) - call psb_bcast(ictxt,istopc) - call psb_bcast(ictxt,itmax) - call psb_bcast(ictxt,itrace) - call psb_bcast(ictxt,irst) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,ipart) + call psb_bcast(ctxt,istopc) + call psb_bcast(ctxt,itmax) + call psb_bcast(ctxt,itrace) + call psb_bcast(ctxt,irst) return diff --git a/test/fileread/getp.f90 b/test/fileread/getp.f90 index 5dc39d4e..82bef762 100644 --- a/test/fileread/getp.f90 +++ b/test/fileread/getp.f90 @@ -38,10 +38,10 @@ contains ! ! Get iteration parameters from the command line ! - subroutine get_dparms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,& + subroutine get_dparms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,& & afmt,istopc,itmax,itrace,irst,eps) use psb_base_mod - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=2) :: filefmt character(len=40) :: kmethd, mtrx_file, rhs_file, ptype character(len=20) :: part @@ -53,7 +53,7 @@ contains integer(psb_ipk_) :: inparms(40), ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (iam == 0) then if (command_argument_count()>0) then call get_command_argument(1,filename) @@ -61,7 +61,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -81,13 +81,13 @@ contains read(inp_unit,*) part - call psb_bcast(ictxt,mtrx_file) - call psb_bcast(ictxt,rhs_file) - call psb_bcast(ictxt,filefmt) - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,part) + call psb_bcast(ctxt,mtrx_file) + call psb_bcast(ctxt,rhs_file) + call psb_bcast(ctxt,filefmt) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,part) if (ip >= 7) then read(inp_unit,*) istopc @@ -118,8 +118,8 @@ contains inparms(2) = itmax inparms(3) = itrace inparms(4) = irst - call psb_bcast(ictxt,inparms(1:4)) - call psb_bcast(ictxt,eps) + call psb_bcast(ctxt,inparms(1:4)) + call psb_bcast(ctxt,eps) write(psb_out_unit,'("Solving matrix : ",a)') mtrx_file write(psb_out_unit,'("Number of processors : ",i3)') np @@ -131,7 +131,7 @@ contains write(psb_out_unit,'(" ")') else write(psb_err_unit,*) 'Wrong format for input file' - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 end if if (inp_unit /= psb_inp_unit) then @@ -139,29 +139,29 @@ contains end if else ! Receive Parameters - call psb_bcast(ictxt,mtrx_file) - call psb_bcast(ictxt,rhs_file) - call psb_bcast(ictxt,filefmt) - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,part) + call psb_bcast(ctxt,mtrx_file) + call psb_bcast(ctxt,rhs_file) + call psb_bcast(ctxt,filefmt) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,part) - call psb_bcast(ictxt,inparms(1:4)) + call psb_bcast(ctxt,inparms(1:4)) istopc = inparms(1) itmax = inparms(2) itrace = inparms(3) irst = inparms(4) - call psb_bcast(ictxt,eps) + call psb_bcast(ctxt,eps) end if end subroutine get_dparms - subroutine get_sparms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,& + subroutine get_sparms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,& & afmt,istopc,itmax,itrace,irst,eps) use psb_base_mod - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt character(len=2) :: filefmt character(len=40) :: kmethd, mtrx_file, rhs_file, ptype character(len=20) :: part @@ -173,7 +173,7 @@ contains integer(psb_ipk_) :: inparms(40), ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if (iam == 0) then if (command_argument_count()>0) then call get_command_argument(1,filename) @@ -181,7 +181,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -201,13 +201,13 @@ contains read(inp_unit,*) ipart - call psb_bcast(ictxt,mtrx_file) - call psb_bcast(ictxt,rhs_file) - call psb_bcast(ictxt,filefmt) - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,part) + call psb_bcast(ctxt,mtrx_file) + call psb_bcast(ctxt,rhs_file) + call psb_bcast(ctxt,filefmt) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,part) if (ip >= 7) then read(inp_unit,*) istopc @@ -238,8 +238,8 @@ contains inparms(2) = itmax inparms(3) = itrace inparms(4) = irst - call psb_bcast(ictxt,inparms(1:4)) - call psb_bcast(ictxt,eps) + call psb_bcast(ctxt,inparms(1:4)) + call psb_bcast(ctxt,eps) write(psb_out_unit,'("Solving matrix : ",a)') mtrx_file write(psb_out_unit,'("Number of processors : ",i3)') np @@ -251,7 +251,7 @@ contains write(psb_out_unit,'(" ")') else write(psb_err_unit,*) 'Wrong format for input file' - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 end if if (inp_unit /= psb_inp_unit) then @@ -259,20 +259,20 @@ contains end if else ! Receive Parameters - call psb_bcast(ictxt,mtrx_file) - call psb_bcast(ictxt,rhs_file) - call psb_bcast(ictxt,filefmt) - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,part) + call psb_bcast(ctxt,mtrx_file) + call psb_bcast(ctxt,rhs_file) + call psb_bcast(ctxt,filefmt) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,part) - call psb_bcast(ictxt,inparms(1:4)) + call psb_bcast(ctxt,inparms(1:4)) istopc = inparms(1) itmax = inparms(2) itrace = inparms(3) irst = inparms(4) - call psb_bcast(ictxt,eps) + call psb_bcast(ctxt,eps) end if diff --git a/test/fileread/psb_cf_sample.f90 b/test/fileread/psb_cf_sample.f90 index 25f8533c..d1d620e0 100644 --- a/test/fileread/psb_cf_sample.f90 +++ b/test/fileread/psb_cf_sample.f90 @@ -56,7 +56,7 @@ program psb_cf_sample ! communications data structure type(psb_desc_type):: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters @@ -82,12 +82,12 @@ program psb_cf_sample character(len=40) :: fname, fnout - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif @@ -106,10 +106,10 @@ program psb_cf_sample ! ! get parameters ! - call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& + call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& & part,afmt,istopc,itmax,itrace,irst,eps) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! read the input matrix to be processed and (possibly) the rhs nrhs = 1 @@ -137,11 +137,11 @@ program psb_cf_sample end select if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' - call psb_abort(ictxt) + call psb_abort(ctxt) end if m_problem = aux_a%get_nrows() - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated if (size(aux_b,dim=1) == m_problem) then @@ -166,7 +166,7 @@ program psb_cf_sample endif else - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) end if @@ -174,7 +174,7 @@ program psb_cf_sample select case(psb_toupper(part)) case('BLOCK') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) case('GRAPH') if (iam == psb_root_) then @@ -186,14 +186,14 @@ program psb_cf_sample call build_mtpart(aux_a,lnp) endif - call psb_barrier(ictxt) - call distr_mtpart(psb_root_,ictxt) + call psb_barrier(ctxt) + call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) @@ -206,7 +206,7 @@ program psb_cf_sample t2 = psb_wtime() - t1 - call psb_amx(ictxt, t2) + call psb_amx(ctxt, t2) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -216,7 +216,7 @@ program psb_cf_sample ! - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) ! building the preconditioner t1 = psb_wtime() @@ -228,7 +228,7 @@ program psb_cf_sample end if - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if(iam == psb_root_) then write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec @@ -236,14 +236,14 @@ program psb_cf_sample end if iparm = 0 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,& & istop=istopc,irst=irst) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) call psb_geaxpby(cone,b_col,czero,r_col,desc_a,info) call psb_spmm(-cone,a,x_col,cone,r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info) @@ -252,9 +252,9 @@ program psb_cf_sample amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then call prec%descr() write(psb_out_unit,'("Matrix: ",a)')mtrx_file @@ -304,10 +304,10 @@ program psb_cf_sample call psb_spfree(a, desc_a,info) call prec%free(info) call psb_cdfree(desc_a,info) - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop end program psb_cf_sample diff --git a/test/fileread/psb_df_sample.f90 b/test/fileread/psb_df_sample.f90 index 8c7f56d2..c67a07ca 100644 --- a/test/fileread/psb_df_sample.f90 +++ b/test/fileread/psb_df_sample.f90 @@ -56,7 +56,7 @@ program psb_df_sample ! communications data structure type(psb_desc_type):: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters @@ -82,12 +82,12 @@ program psb_df_sample character(len=40) :: fname, fnout - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif @@ -106,10 +106,10 @@ program psb_df_sample ! ! get parameters ! - call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& + call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& & part,afmt,istopc,itmax,itrace,irst,eps) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! read the input matrix to be processed and (possibly) the rhs nrhs = 1 @@ -137,11 +137,11 @@ program psb_df_sample end select if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' - call psb_abort(ictxt) + call psb_abort(ctxt) end if m_problem = aux_a%get_nrows() - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated if (size(aux_b,dim=1) == m_problem) then @@ -166,7 +166,7 @@ program psb_df_sample endif else - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) end if @@ -174,7 +174,7 @@ program psb_df_sample select case(psb_toupper(part)) case('BLOCK') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) case('GRAPH') if (iam == psb_root_) then @@ -186,14 +186,14 @@ program psb_df_sample call build_mtpart(aux_a,lnp) endif - call psb_barrier(ictxt) - call distr_mtpart(psb_root_,ictxt) + call psb_barrier(ctxt) + call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) @@ -206,7 +206,7 @@ program psb_df_sample t2 = psb_wtime() - t1 - call psb_amx(ictxt, t2) + call psb_amx(ctxt, t2) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -216,7 +216,7 @@ program psb_df_sample ! - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) ! building the preconditioner t1 = psb_wtime() @@ -228,7 +228,7 @@ program psb_df_sample end if - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if(iam == psb_root_) then write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec @@ -237,14 +237,14 @@ program psb_df_sample cond = dzero iparm = 0 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,& & istop=istopc,irst=irst,cond=cond) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) call psb_geaxpby(done,b_col,dzero,r_col,desc_a,info) call psb_spmm(-done,a,x_col,done,r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info) @@ -253,9 +253,9 @@ program psb_df_sample amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then call prec%descr() write(psb_out_unit,'("Matrix: ",a)')mtrx_file @@ -306,10 +306,10 @@ program psb_df_sample call psb_spfree(a, desc_a,info) call prec%free(info) call psb_cdfree(desc_a,info) - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop end program psb_df_sample diff --git a/test/fileread/psb_sf_sample.f90 b/test/fileread/psb_sf_sample.f90 index cf49b1a6..c86f5f4d 100644 --- a/test/fileread/psb_sf_sample.f90 +++ b/test/fileread/psb_sf_sample.f90 @@ -56,7 +56,7 @@ program psb_sf_sample ! communications data structure type(psb_desc_type):: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters @@ -82,12 +82,12 @@ program psb_sf_sample character(len=40) :: fname, fnout - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif @@ -106,10 +106,10 @@ program psb_sf_sample ! ! get parameters ! - call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& + call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& & part,afmt,istopc,itmax,itrace,irst,eps) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! read the input matrix to be processed and (possibly) the rhs nrhs = 1 @@ -137,11 +137,11 @@ program psb_sf_sample end select if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' - call psb_abort(ictxt) + call psb_abort(ctxt) end if m_problem = aux_a%get_nrows() - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated if (size(aux_b,dim=1) == m_problem) then @@ -166,7 +166,7 @@ program psb_sf_sample endif else - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) end if @@ -174,7 +174,7 @@ program psb_sf_sample select case(psb_toupper(part)) case('BLOCK') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) case('GRAPH') if (iam == psb_root_) then @@ -186,14 +186,14 @@ program psb_sf_sample call build_mtpart(aux_a,lnp) endif - call psb_barrier(ictxt) - call distr_mtpart(psb_root_,ictxt) + call psb_barrier(ctxt) + call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) @@ -206,7 +206,7 @@ program psb_sf_sample t2 = psb_wtime() - t1 - call psb_amx(ictxt, t2) + call psb_amx(ctxt, t2) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -216,7 +216,7 @@ program psb_sf_sample ! - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) ! building the preconditioner t1 = psb_wtime() @@ -228,7 +228,7 @@ program psb_sf_sample end if - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if(iam == psb_root_) then write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec @@ -237,14 +237,14 @@ program psb_sf_sample cond = szero iparm = 0 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,& & istop=istopc,irst=irst,cond=cond) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) call psb_geaxpby(sone,b_col,szero,r_col,desc_a,info) call psb_spmm(-sone,a,x_col,sone,r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info) @@ -253,9 +253,9 @@ program psb_sf_sample amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then call prec%descr() write(psb_out_unit,'("Matrix: ",a)')mtrx_file @@ -306,10 +306,10 @@ program psb_sf_sample call psb_spfree(a, desc_a,info) call prec%free(info) call psb_cdfree(desc_a,info) - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop end program psb_sf_sample diff --git a/test/fileread/psb_zf_sample.f90 b/test/fileread/psb_zf_sample.f90 index 58028532..18d61022 100644 --- a/test/fileread/psb_zf_sample.f90 +++ b/test/fileread/psb_zf_sample.f90 @@ -56,7 +56,7 @@ program psb_zf_sample ! communications data structure type(psb_desc_type):: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np integer(psb_lpk_) :: lnp ! solver paramters @@ -82,12 +82,12 @@ program psb_zf_sample character(len=40) :: fname, fnout - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif @@ -106,10 +106,10 @@ program psb_zf_sample ! ! get parameters ! - call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& + call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,& & part,afmt,istopc,itmax,itrace,irst,eps) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! read the input matrix to be processed and (possibly) the rhs nrhs = 1 @@ -137,11 +137,11 @@ program psb_zf_sample end select if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' - call psb_abort(ictxt) + call psb_abort(ctxt) end if m_problem = aux_a%get_nrows() - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated if (size(aux_b,dim=1) == m_problem) then @@ -166,7 +166,7 @@ program psb_zf_sample endif else - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) end if @@ -174,7 +174,7 @@ program psb_zf_sample select case(psb_toupper(part)) case('BLOCK') if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) case('GRAPH') if (iam == psb_root_) then @@ -186,14 +186,14 @@ program psb_zf_sample call build_mtpart(aux_a,lnp) endif - call psb_barrier(ictxt) - call distr_mtpart(psb_root_,ictxt) + call psb_barrier(ctxt) + call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,parts=part_block) end select call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_) @@ -206,7 +206,7 @@ program psb_zf_sample t2 = psb_wtime() - t1 - call psb_amx(ictxt, t2) + call psb_amx(ctxt, t2) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -216,7 +216,7 @@ program psb_zf_sample ! - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) ! building the preconditioner t1 = psb_wtime() @@ -228,7 +228,7 @@ program psb_zf_sample end if - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if(iam == psb_root_) then write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec @@ -236,14 +236,14 @@ program psb_zf_sample end if iparm = 0 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,& & istop=istopc,irst=irst) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info) call psb_spmm(-zone,a,x_col,zone,r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info) @@ -252,9 +252,9 @@ program psb_zf_sample amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then call prec%descr() write(psb_out_unit,'("Matrix: ",a)')mtrx_file @@ -304,10 +304,10 @@ program psb_zf_sample call psb_spfree(a, desc_a,info) call prec%free(info) call psb_cdfree(desc_a,info) - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop end program psb_zf_sample diff --git a/test/kernel/d_file_spmv.f90 b/test/kernel/d_file_spmv.f90 index f7bb3932..ec48a68d 100644 --- a/test/kernel/d_file_spmv.f90 +++ b/test/kernel/d_file_spmv.f90 @@ -51,7 +51,7 @@ program d_file_spmv ! communications data structure type(psb_desc_type):: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver paramters @@ -77,12 +77,12 @@ program d_file_spmv integer(psb_ipk_), allocatable :: ivg(:), ipv(:) - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif @@ -101,12 +101,12 @@ program d_file_spmv read(psb_inp_unit,*) filefmt read(psb_inp_unit,*) ipart end if - call psb_bcast(ictxt,mtrx_file) - call psb_bcast(ictxt,filefmt) - call psb_bcast(ictxt,ipart) + call psb_bcast(ctxt,mtrx_file) + call psb_bcast(ctxt,filefmt) + call psb_bcast(ctxt,ipart) rhs_file = 'NONE' afmt = 'CSR' - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! read the input matrix to be processed and (possibly) the rhs nrhs = 1 @@ -134,11 +134,11 @@ program d_file_spmv end select if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' - call psb_abort(ictxt) + call psb_abort(ctxt) end if m_problem = aux_a%get_nrows() - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated if (psb_size(aux_b,dim=1)==m_problem) then @@ -162,7 +162,7 @@ program d_file_spmv else - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) b_col_glob =>aux_b(:,1) end if @@ -170,14 +170,14 @@ program d_file_spmv ! switch over different partition types write(psb_out_unit,'("Number of processors : ",i0)')np if (ipart == 0) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (iam==psb_root_) write(psb_out_unit,'("Partition type: block")') allocate(ivg(m_problem),ipv(np)) do i=1,m_problem call part_block(i,m_problem,np,ipv,nv) ivg(i) = ipv(1) enddo - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) else if (ipart == 2) then if (iam==psb_root_) then @@ -187,14 +187,14 @@ program d_file_spmv call build_mtpart(aux_a,np) endif - call psb_barrier(ictxt) - call distr_mtpart(psb_root_,ictxt) + call psb_barrier(ctxt) + call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt, desc_a,info,fmt=afmt,vg=ivg) else if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")') - call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt, desc_a,info,fmt=afmt,parts=part_block) end if @@ -207,7 +207,7 @@ program d_file_spmv t2 = psb_wtime() - t1 - call psb_amx(ictxt, t2) + call psb_amx(ctxt, t2) if (iam==psb_root_) then write(psb_out_unit,'(" ")') @@ -216,32 +216,32 @@ program d_file_spmv end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do i=1,times call psb_spmm(done,a,x_col,dzero,b_col,desc_a,info,'n') end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) ! FIXME: cache flush needed here - call psb_barrier(ictxt) + call psb_barrier(ctxt) tt1 = psb_wtime() do i=1,times call psb_spmm(done,a,x_col,dzero,b_col,desc_a,info,'t') end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) tt2 = psb_wtime() - tt1 - call psb_amx(ictxt,tt2) + call psb_amx(ctxt,tt2) nr = desc_a%get_global_rows() annz = a%get_nzeros() amatsize = psb_sizeof(a) descsize = psb_sizeof(desc_a) - call psb_sum(ictxt,annz) - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) + call psb_sum(ctxt,annz) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) if (iam==psb_root_) then flops = 2.d0*times*annz @@ -280,10 +280,10 @@ program d_file_spmv call psb_gefree(x_col, desc_a,info) call psb_spfree(a, desc_a,info) call psb_cdfree(desc_a,info) - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop diff --git a/test/kernel/pdgenspmv.f90 b/test/kernel/pdgenspmv.f90 index aaf16fe6..e96736a8 100644 --- a/test/kernel/pdgenspmv.f90 +++ b/test/kernel/pdgenspmv.f90 @@ -141,7 +141,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + subroutine psb_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod @@ -165,7 +165,7 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f @@ -208,7 +208,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (present(f)) then @@ -254,12 +254,12 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -267,7 +267,7 @@ contains ! First example of use of CDALL: specify for each process a number of ! contiguous rows ! - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -278,15 +278,15 @@ contains if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -294,7 +294,7 @@ contains ! Second example of use of CDALL: specify for each row the ! process that owns it ! - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -336,21 +336,21 @@ contains write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& & nr,nlr,mynx,myny,mynz info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) end if ! ! Third example of use of CDALL: specify for each process ! the set of global indices it owns. ! - call psb_cdall(ictxt,desc_a,info,vl=myidx) + call psb_cdall(ctxt,desc_a,info,vl=myidx) case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end select @@ -360,7 +360,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -386,7 +386,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -487,11 +487,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -500,7 +500,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -516,13 +516,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -537,7 +537,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_gen_pde3d @@ -568,7 +568,7 @@ program pdgenspmv type(psb_d_vect_type) :: xv,bv, vtst real(psb_dpk_), allocatable :: tst(:) ! blacs parameters - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -585,12 +585,12 @@ program pdgenspmv info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_get_errstatus() /= 0) goto 9999 @@ -606,15 +606,15 @@ program pdgenspmv ! ! get parameters ! - call get_parms(ictxt,afmt,idim) + call get_parms(ctxt,afmt,idim) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info) - call psb_barrier(ictxt) + call psb_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -627,7 +627,7 @@ program pdgenspmv call xv%set(done) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! ! Perform Ax multiple times to compute average performance @@ -635,12 +635,12 @@ program pdgenspmv do i=1,times call psb_spmm(done,a,xv,dzero,bv,desc_a,info,'n') end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) ! FIXME: cache flush needed here - call psb_barrier(ictxt) + call psb_barrier(ctxt) tt1 = psb_wtime() ! ! Perform A^Tx multiple times to compute average performance @@ -648,18 +648,18 @@ program pdgenspmv do i=1,times call psb_spmm(done,a,xv,dzero,bv,desc_a,info,'t') end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) tt2 = psb_wtime() - tt1 - call psb_amx(ictxt,tt2) + call psb_amx(ctxt,tt2) - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) nr = desc_a%get_global_rows() annz = a%get_nzeros() amatsize = a%sizeof() descsize = psb_sizeof(desc_a) - call psb_sum(ictxt,annz) - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) + call psb_sum(ctxt,annz) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) if (iam == psb_root_) then flops = 2.d0*times*annz @@ -710,10 +710,10 @@ program pdgenspmv goto 9999 end if - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -721,21 +721,21 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,afmt,idim) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,afmt,idim) + type(psb_ctxt_type) :: ctxt character(len=*) :: afmt integer(psb_ipk_) :: idim integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: intbuf(10), ip - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == 0) then read(psb_inp_unit,*) afmt read(psb_inp_unit,*) idim endif - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,idim) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,idim) if (iam == 0) then write(psb_out_unit,'("Testing matrix : ell1")') diff --git a/test/kernel/s_file_spmv.f90 b/test/kernel/s_file_spmv.f90 index 4675a5d5..0f75518e 100644 --- a/test/kernel/s_file_spmv.f90 +++ b/test/kernel/s_file_spmv.f90 @@ -50,7 +50,7 @@ program s_file_spmv ! communications data structure type(psb_desc_type):: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver paramters @@ -76,12 +76,12 @@ program s_file_spmv integer(psb_ipk_), allocatable :: ivg(:), ipv(:) - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif @@ -100,12 +100,12 @@ program s_file_spmv read(psb_inp_unit,*) filefmt read(psb_inp_unit,*) ipart end if - call psb_bcast(ictxt,mtrx_file) - call psb_bcast(ictxt,filefmt) - call psb_bcast(ictxt,ipart) + call psb_bcast(ctxt,mtrx_file) + call psb_bcast(ctxt,filefmt) + call psb_bcast(ctxt,ipart) rhs_file = 'NONE' afmt = 'CSR' - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() ! read the input matrix to be processed and (possibly) the rhs nrhs = 1 @@ -133,11 +133,11 @@ program s_file_spmv end select if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' - call psb_abort(ictxt) + call psb_abort(ctxt) end if m_problem = aux_a%get_nrows() - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated if (psb_size(aux_b,dim=1)==m_problem) then @@ -161,7 +161,7 @@ program s_file_spmv else - call psb_bcast(ictxt,m_problem) + call psb_bcast(ctxt,m_problem) b_col_glob =>aux_b(:,1) end if @@ -169,14 +169,14 @@ program s_file_spmv ! switch over different partition types write(psb_out_unit,'("Number of processors : ",i0)')np if (ipart == 0) then - call psb_barrier(ictxt) + call psb_barrier(ctxt) if (iam==psb_root_) write(psb_out_unit,'("Partition type: block")') allocate(ivg(m_problem),ipv(np)) do i=1,m_problem call part_block(i,m_problem,np,ipv,nv) ivg(i) = ipv(1) enddo - call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) else if (ipart == 2) then if (iam==psb_root_) then @@ -186,14 +186,14 @@ program s_file_spmv call build_mtpart(aux_a,np) endif - call psb_barrier(ictxt) - call distr_mtpart(psb_root_,ictxt) + call psb_barrier(ctxt) + call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) - call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,vg=ivg) + call psb_matdist(aux_a, a, ctxt, desc_a,info,fmt=afmt,vg=ivg) else if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")') - call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block) + call psb_matdist(aux_a, a, ctxt, desc_a,info,fmt=afmt,parts=part_block) end if call psb_geall(x_col,desc_a,info) @@ -205,7 +205,7 @@ program s_file_spmv t2 = psb_wtime() - t1 - call psb_amx(ictxt, t2) + call psb_amx(ctxt, t2) if (iam==psb_root_) then write(psb_out_unit,'(" ")') @@ -214,32 +214,32 @@ program s_file_spmv end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do i=1,times call psb_spmm(sone,a,x_col,szero,b_col,desc_a,info,'n') end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) ! FIXME: cache flush needed here - call psb_barrier(ictxt) + call psb_barrier(ctxt) tt1 = psb_wtime() do i=1,times call psb_spmm(sone,a,x_col,szero,b_col,desc_a,info,'t') end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) tt2 = psb_wtime() - tt1 - call psb_amx(ictxt,tt2) + call psb_amx(ctxt,tt2) nr = desc_a%get_global_rows() annz = a%get_nzeros() amatsize = psb_sizeof(a) descsize = psb_sizeof(desc_a) - call psb_sum(ictxt,annz) - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) + call psb_sum(ctxt,annz) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) if (iam==psb_root_) then flops = 2.d0*times*annz @@ -278,10 +278,10 @@ program s_file_spmv call psb_spfree(a, desc_a,info) call psb_cdfree(desc_a,info) - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop diff --git a/test/kernel/vecoperation.f90 b/test/kernel/vecoperation.f90 index 139364aa..3860a3c3 100644 --- a/test/kernel/vecoperation.f90 +++ b/test/kernel/vecoperation.f90 @@ -43,14 +43,14 @@ module unittestvector_mod contains - function psb_check_ans(v,val,ictxt) result(ans) + function psb_check_ans(v,val,ctxt) result(ans) use psb_base_mod implicit none type(psb_d_vect_type) :: v real(psb_dpk_) :: val - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt logical :: ans ! Local variables @@ -58,14 +58,14 @@ contains real(psb_dpk_) :: check real(psb_dpk_), allocatable :: va(:) - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) va = v%get_vect() va = va - val; check = maxval(va); - call psb_sum(ictxt,check) + call psb_sum(ctxt,check) if(check == 0.d0) then ans = .true. @@ -77,14 +77,14 @@ contains ! ! subroutine to fill a vector with constant entries ! - subroutine psb_d_gen_const(v,val,idim,ictxt,desc_a,info) + subroutine psb_d_gen_const(v,val,idim,ctxt,desc_a,info) use psb_base_mod implicit none type(psb_d_vect_type) :: v type(psb_desc_type) :: desc_a integer(psb_lpk_) :: idim - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info real(psb_dpk_) :: val @@ -102,7 +102,7 @@ contains name = 'create_constant_vector' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) n = idim*np ! The global dimension is the number of process times ! the input size @@ -112,16 +112,16 @@ contains nr = max(0,min(nt,n-(iam*nt))) nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= n) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,n info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if ! Allocate the descriptor with simple minded data distribution - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) ! Allocate the vector on the recently build descriptor if (info == psb_success_) call psb_geall(v,desc_a,info) ! Check that allocation has gone good @@ -156,7 +156,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_gen_const @@ -185,7 +185,7 @@ program vecoperation ! vector type(psb_d_vect_type) :: x,y,z ! blacs parameters - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! auxiliary parameters integer(psb_ipk_) :: info @@ -197,11 +197,11 @@ program vecoperation real(psb_dpk_) :: zt(1) info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then - call psb_exit(ictxt) ! This should not happen, but just in case + call psb_exit(ctxt) ! This should not happen, but just in case stop endif if(psb_get_errstatus() /= 0) goto 9999 @@ -229,112 +229,112 @@ program vecoperation if (iam == psb_root_) write(psb_out_unit,'("Standard Vector Operations")') if (iam == psb_root_) write(psb_out_unit,'(" ")') ! X = 1 - call psb_d_gen_const(x,one,idim,ictxt,desc_a,info) - hasitnotfailed = psb_check_ans(x,one,ictxt) + call psb_d_gen_const(x,one,idim,ctxt,desc_a,info) + hasitnotfailed = psb_check_ans(x,one,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> Constant vector ")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- Constant vector ")') end if ! X = 1 , Y = -2, Y = X + Y = 1 -2 = -1 - call psb_d_gen_const(x,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,negativetwo,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,negativetwo,idim,ctxt,desc_a,info) call psb_geaxpby(one,x,one,y,desc_a,info) - hasitnotfailed = psb_check_ans(y,negativeone,ictxt) + hasitnotfailed = psb_check_ans(y,negativeone,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> axpby Y = X + Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- axpby Y = X + Y ")') end if ! X = 1 , Y = 2, Y = -X + Y = -1 +2 = 1 - call psb_d_gen_const(x,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,two,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,two,idim,ctxt,desc_a,info) call psb_geaxpby(negativeone,x,one,y,desc_a,info) - hasitnotfailed = psb_check_ans(y,one,ictxt) + hasitnotfailed = psb_check_ans(y,one,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> axpby Y = -X + Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- axpby Y = -X + Y ")') end if ! X = 2 , Y = -2, Y = 0.5*X + Y = 1 - 2 = -1 - call psb_d_gen_const(x,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,negativetwo,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,negativetwo,idim,ctxt,desc_a,info) call psb_geaxpby(onehalf,x,one,y,desc_a,info) - hasitnotfailed = psb_check_ans(y,negativeone,ictxt) + hasitnotfailed = psb_check_ans(y,negativeone,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> axpby Y = 0.5 X + Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- axpby Y = 0.5 X + Y ")') end if ! X = -2 , Y = 1, Z = 0, Z = X + Y = -2 + 1 = -1 - call psb_d_gen_const(x,negativetwo,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,negativetwo,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_geaxpby(one,x,one,y,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,negativeone,ictxt) + hasitnotfailed = psb_check_ans(z,negativeone,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> axpby Z = X + Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- axpby Z = X + Y ")') end if ! X = 2 , Y = 1, Z = 0, Z = X - Y = 2 - 1 = 1 - call psb_d_gen_const(x,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_geaxpby(one,x,negativeone,y,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,one,ictxt) + hasitnotfailed = psb_check_ans(z,one,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> axpby Z = X - Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- axpby Z = X - Y ")') end if ! X = 2 , Y = 1, Z = 0, Z = -X + Y = -2 + 1 = -1 - call psb_d_gen_const(x,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_geaxpby(negativeone,x,one,y,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,negativeone,ictxt) + hasitnotfailed = psb_check_ans(z,negativeone,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> axpby Z = -X + Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- axpby Z = -X + Y ")') end if ! X = 2 , Y = -0.5, Z = 0, Z = X*Y = 2*(-0.5) = -1 - call psb_d_gen_const(x,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,negativeonehalf,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,negativeonehalf,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_gemlt(one,x,y,dzero,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,negativeone,ictxt) + hasitnotfailed = psb_check_ans(z,negativeone,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> mlt Z = X*Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- mlt Z = X*Y ")') end if ! X = 1 , Y = 2, Z = 0, Z = X/Y = 1/2 = 0.5 - call psb_d_gen_const(x,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_gediv(x,y,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,onehalf,ictxt) + hasitnotfailed = psb_check_ans(z,onehalf,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> div Z = X/Y")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- div Z = X/Y ")') end if ! X = -1 , Z = 0, Z = |X| = |-1| = 1 - call psb_d_gen_const(x,negativeone,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,negativeone,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_geabs(x,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,one,ictxt) + hasitnotfailed = psb_check_ans(z,one,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> abs Z = |X|")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- abs Z = |X| ")') end if ! X = 2 , Z = 0, Z = 1/X = 1/2 = 0.5 - call psb_d_gen_const(x,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_geinv(x,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,onehalf,ictxt) + hasitnotfailed = psb_check_ans(z,onehalf,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> inv Z = 1/X")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- inv Z = 1/X ")') end if ! X = 1, Z = 0, c = -2, Z = X + c = -1 - call psb_d_gen_const(x,one,idim,ictxt,desc_a,info) - call psb_d_gen_const(z,dzero,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,one,idim,ctxt,desc_a,info) + call psb_d_gen_const(z,dzero,idim,ctxt,desc_a,info) call psb_geaddconst(x,negativetwo,z,desc_a,info) - hasitnotfailed = psb_check_ans(z,negativeone,ictxt) + hasitnotfailed = psb_check_ans(z,negativeone,ctxt) if (iam == psb_root_) then if(hasitnotfailed) write(psb_out_unit,'("TEST PASSED >>> Add constant Z = X + c")') if(.not.hasitnotfailed) write(psb_out_unit,'("TEST FAILED --- Add constant Z = X + c")') @@ -348,15 +348,15 @@ program vecoperation if (iam == psb_root_) write(psb_out_unit,'(" ")') ! Dot product - call psb_d_gen_const(x,two,idim,ictxt,desc_a,info) - call psb_d_gen_const(y,onehalf,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,two,idim,ctxt,desc_a,info) + call psb_d_gen_const(y,onehalf,idim,ctxt,desc_a,info) ans = psb_gedot(x,y,desc_a,info) if (iam == psb_root_) then if(ans == np*idim) write(psb_out_unit,'("TEST PASSED >>> Dot product")') if(ans /= np*idim) write(psb_out_unit,'("TEST FAILED --- Dot product")') end if ! MaxNorm - call psb_d_gen_const(x,negativeonehalf,idim,ictxt,desc_a,info) + call psb_d_gen_const(x,negativeonehalf,idim,ctxt,desc_a,info) ans = psb_geamax(x,desc_a,info) if (iam == psb_root_) then if(ans == onehalf) write(psb_out_unit,'("TEST PASSED >>> MaxNorm")') @@ -376,10 +376,10 @@ program vecoperation - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop end program vecoperation diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index 51a4e7d1..edd5034f 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -152,7 +152,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + subroutine psb_d_gen_pde2d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod @@ -176,7 +176,7 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_2d), optional :: f @@ -219,7 +219,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (present(f)) then @@ -265,12 +265,12 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -278,7 +278,7 @@ contains ! First example of use of CDALL: specify for each process a number of ! contiguous rows ! - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -289,15 +289,15 @@ contains if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -305,7 +305,7 @@ contains ! Second example of use of CDALL: specify for each row the ! process that owns it ! - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -342,21 +342,21 @@ contains write(psb_err_unit,*) iam,iamx,iamy, 'Initialization error: NR vs NLR ',& & nr,nlr,mynx,myny info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) end if ! ! Third example of use of CDALL: specify for each process ! the set of global indices it owns. ! - call psb_cdall(ictxt,desc_a,info,vl=myidx) + call psb_cdall(ctxt,desc_a,info,vl=myidx) case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end select @@ -366,7 +366,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -392,7 +392,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -474,11 +474,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -487,7 +487,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -503,13 +503,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -524,7 +524,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_gen_pde2d @@ -557,7 +557,7 @@ program psb_d_pde2d ! dense vectors type(psb_d_vect_type) :: xxv,bv ! parallel environment - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -573,12 +573,12 @@ program psb_d_pde2d info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_errstatus_fatal()) goto 9999 @@ -594,15 +594,15 @@ program psb_d_pde2d ! ! get parameters ! - call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + call get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() - call psb_gen_pde2d(ictxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) - call psb_barrier(ictxt) + call psb_gen_pde2d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -616,9 +616,9 @@ program psb_d_pde2d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call prec%build(a,desc_a,info) if(info /= psb_success_) then @@ -630,7 +630,7 @@ program psb_d_pde2d tprec = psb_wtime()-t1 - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if (iam == psb_root_) write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec if (iam == psb_root_) write(psb_out_unit,'(" ")') @@ -639,7 +639,7 @@ program psb_d_pde2d ! iterative method parameters ! if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& @@ -652,16 +652,16 @@ program psb_d_pde2d goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() system_size = desc_a%get_global_rows() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -695,10 +695,10 @@ program psb_d_pde2d goto 9999 end if - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -706,15 +706,15 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + type(psb_ctxt_type) :: ctxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == 0) then if (command_argument_count()>0) then @@ -723,7 +723,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -782,7 +782,7 @@ contains else ! wrong number of parameter, print an error message and exit call pr_usage(izero) - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 endif if (inp_unit /= psb_inp_unit) then @@ -791,15 +791,15 @@ contains end if ! broadcast parameters to all processors - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,idim) - call psb_bcast(ictxt,ipart) - call psb_bcast(ictxt,istopc) - call psb_bcast(ictxt,itmax) - call psb_bcast(ictxt,itrace) - call psb_bcast(ictxt,irst) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,ipart) + call psb_bcast(ctxt,istopc) + call psb_bcast(ctxt,itmax) + call psb_bcast(ctxt,itrace) + call psb_bcast(ctxt,irst) return diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index 4080ab9a..8cc14086 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -168,7 +168,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + subroutine psb_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod @@ -192,7 +192,7 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f @@ -235,7 +235,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (present(f)) then @@ -281,12 +281,12 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -294,7 +294,7 @@ contains ! First example of use of CDALL: specify for each process a number of ! contiguous rows ! - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -305,15 +305,15 @@ contains if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -321,7 +321,7 @@ contains ! Second example of use of CDALL: specify for each row the ! process that owns it ! - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -363,21 +363,21 @@ contains write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& & nr,nlr,mynx,myny,mynz info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) end if ! ! Third example of use of CDALL: specify for each process ! the set of global indices it owns. ! - call psb_cdall(ictxt,desc_a,info,vl=myidx) + call psb_cdall(ctxt,desc_a,info,vl=myidx) case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end select @@ -387,7 +387,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -413,7 +413,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -514,11 +514,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -527,7 +527,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -543,13 +543,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -564,7 +564,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_gen_pde3d @@ -598,7 +598,7 @@ program psb_d_pde3d ! dense vectors type(psb_d_vect_type) :: xxv,bv ! parallel environment - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -614,12 +614,12 @@ program psb_d_pde3d info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_errstatus_fatal()) goto 9999 @@ -635,15 +635,15 @@ program psb_d_pde3d ! ! get parameters ! - call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + call get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) - call psb_barrier(ictxt) + call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -657,9 +657,9 @@ program psb_d_pde3d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call prec%build(a,desc_a,info) if(info /= psb_success_) then @@ -671,7 +671,7 @@ program psb_d_pde3d tprec = psb_wtime()-t1 - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if (iam == psb_root_) write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec if (iam == psb_root_) write(psb_out_unit,'(" ")') @@ -680,7 +680,7 @@ program psb_d_pde3d ! iterative method parameters ! if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& @@ -693,16 +693,16 @@ program psb_d_pde3d goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() system_size = desc_a%get_global_rows() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -736,10 +736,10 @@ program psb_d_pde3d goto 9999 end if - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -747,15 +747,15 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + type(psb_ctxt_type) :: ctxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == 0) then if (command_argument_count()>0) then @@ -764,7 +764,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -825,7 +825,7 @@ contains else ! wrong number of parameter, print an error message and exit call pr_usage(izero) - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 endif if (inp_unit /= psb_inp_unit) then @@ -834,15 +834,15 @@ contains end if ! broadcast parameters to all processors - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,idim) - call psb_bcast(ictxt,ipart) - call psb_bcast(ictxt,istopc) - call psb_bcast(ictxt,itmax) - call psb_bcast(ictxt,itrace) - call psb_bcast(ictxt,irst) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,ipart) + call psb_bcast(ctxt,istopc) + call psb_bcast(ctxt,itmax) + call psb_bcast(ctxt,itrace) + call psb_bcast(ctxt,irst) return diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index 2a79da53..63cb4860 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -152,7 +152,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_s_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + subroutine psb_s_gen_pde2d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod @@ -176,7 +176,7 @@ contains type(psb_sspmat_type) :: a type(psb_s_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(s_func_2d), optional :: f @@ -219,7 +219,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (present(f)) then @@ -265,12 +265,12 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -278,7 +278,7 @@ contains ! First example of use of CDALL: specify for each process a number of ! contiguous rows ! - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -289,15 +289,15 @@ contains if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -305,7 +305,7 @@ contains ! Second example of use of CDALL: specify for each row the ! process that owns it ! - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -342,21 +342,21 @@ contains write(psb_err_unit,*) iam,iamx,iamy, 'Initialization error: NR vs NLR ',& & nr,nlr,mynx,myny info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) end if ! ! Third example of use of CDALL: specify for each process ! the set of global indices it owns. ! - call psb_cdall(ictxt,desc_a,info,vl=myidx) + call psb_cdall(ctxt,desc_a,info,vl=myidx) case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end select @@ -366,7 +366,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -392,7 +392,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -474,11 +474,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -487,7 +487,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -503,13 +503,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -524,7 +524,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_s_gen_pde2d @@ -557,7 +557,7 @@ program psb_s_pde2d ! dense vectors type(psb_s_vect_type) :: xxv,bv ! parallel environment - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -573,12 +573,12 @@ program psb_s_pde2d info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_errstatus_fatal()) goto 9999 @@ -594,15 +594,15 @@ program psb_s_pde2d ! ! get parameters ! - call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + call get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() - call psb_gen_pde2d(ictxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) - call psb_barrier(ictxt) + call psb_gen_pde2d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -616,9 +616,9 @@ program psb_s_pde2d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call prec%build(a,desc_a,info) if(info /= psb_success_) then @@ -630,7 +630,7 @@ program psb_s_pde2d tprec = psb_wtime()-t1 - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if (iam == psb_root_) write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec if (iam == psb_root_) write(psb_out_unit,'(" ")') @@ -639,7 +639,7 @@ program psb_s_pde2d ! iterative method parameters ! if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& @@ -652,16 +652,16 @@ program psb_s_pde2d goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() system_size = desc_a%get_global_rows() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -695,10 +695,10 @@ program psb_s_pde2d goto 9999 end if - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -706,15 +706,15 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + type(psb_ctxt_type) :: ctxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == 0) then if (command_argument_count()>0) then @@ -723,7 +723,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -782,7 +782,7 @@ contains else ! wrong number of parameter, print an error message and exit call pr_usage(izero) - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 endif if (inp_unit /= psb_inp_unit) then @@ -791,15 +791,15 @@ contains end if ! broadcast parameters to all processors - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,idim) - call psb_bcast(ictxt,ipart) - call psb_bcast(ictxt,istopc) - call psb_bcast(ictxt,itmax) - call psb_bcast(ictxt,itrace) - call psb_bcast(ictxt,irst) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,ipart) + call psb_bcast(ctxt,istopc) + call psb_bcast(ctxt,itmax) + call psb_bcast(ctxt,itrace) + call psb_bcast(ctxt,irst) return diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index da1d65f1..90b4d042 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -168,7 +168,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,& + subroutine psb_s_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& & f,amold,vmold,imold,partition,nrl,iv) use psb_base_mod use psb_util_mod @@ -192,7 +192,7 @@ contains type(psb_sspmat_type) :: a type(psb_s_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(s_func_3d), optional :: f @@ -235,7 +235,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (present(f)) then @@ -281,12 +281,12 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -294,7 +294,7 @@ contains ! First example of use of CDALL: specify for each process a number of ! contiguous rows ! - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -305,15 +305,15 @@ contains if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else write(psb_err_unit,*) iam, 'Initialization error: IV not present' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if @@ -321,7 +321,7 @@ contains ! Second example of use of CDALL: specify for each row the ! process that owns it ! - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) myidx = desc_a%get_global_indices() nlr = size(myidx) @@ -363,21 +363,21 @@ contains write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& & nr,nlr,mynx,myny,mynz info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) end if ! ! Third example of use of CDALL: specify for each process ! the set of global indices it owns. ! - call psb_cdall(ictxt,desc_a,info,vl=myidx) + call psb_cdall(ctxt,desc_a,info,vl=myidx) case default write(psb_err_unit,*) iam, 'Initialization error: should not get here' info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end select @@ -387,7 +387,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -413,7 +413,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -514,11 +514,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -527,7 +527,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -543,13 +543,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -564,7 +564,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_s_gen_pde3d @@ -598,7 +598,7 @@ program psb_s_pde3d ! dense vectors type(psb_s_vect_type) :: xxv,bv ! parallel environment - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -614,12 +614,12 @@ program psb_s_pde3d info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_errstatus_fatal()) goto 9999 @@ -635,15 +635,15 @@ program psb_s_pde3d ! ! get parameters ! - call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + call get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() - call psb_gen_pde3d(ictxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) - call psb_barrier(ictxt) + call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -657,9 +657,9 @@ program psb_s_pde3d ! prepare the preconditioner. ! if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype - call prec%init(ictxt,ptype,info) + call prec%init(ctxt,ptype,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call prec%build(a,desc_a,info) if(info /= psb_success_) then @@ -671,7 +671,7 @@ program psb_s_pde3d tprec = psb_wtime()-t1 - call psb_amx(ictxt,tprec) + call psb_amx(ctxt,tprec) if (iam == psb_root_) write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec if (iam == psb_root_) write(psb_out_unit,'(" ")') @@ -680,7 +680,7 @@ program psb_s_pde3d ! iterative method parameters ! if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() eps = 1.d-6 call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& @@ -693,16 +693,16 @@ program psb_s_pde3d goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_amx(ictxt,t2) + call psb_amx(ctxt,t2) amatsize = a%sizeof() descsize = desc_a%sizeof() precsize = prec%sizeof() system_size = desc_a%get_global_rows() - call psb_sum(ictxt,amatsize) - call psb_sum(ictxt,descsize) - call psb_sum(ictxt,precsize) + call psb_sum(ctxt,amatsize) + call psb_sum(ctxt,descsize) + call psb_sum(ctxt,precsize) if (iam == psb_root_) then write(psb_out_unit,'(" ")') @@ -736,10 +736,10 @@ program psb_s_pde3d goto 9999 end if - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -747,15 +747,15 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart) + type(psb_ctxt_type) :: ctxt character(len=*) :: kmethd, ptype, afmt integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: ip, inp_unit character(len=1024) :: filename - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == 0) then if (command_argument_count()>0) then @@ -764,7 +764,7 @@ contains open(inp_unit,file=filename,action='read',iostat=info) if (info /= 0) then write(psb_err_unit,*) 'Could not open file ',filename,' for input' - call psb_abort(ictxt) + call psb_abort(ctxt) stop else write(psb_err_unit,*) 'Opened file ',trim(filename),' for input' @@ -825,7 +825,7 @@ contains else ! wrong number of parameter, print an error message and exit call pr_usage(izero) - call psb_abort(ictxt) + call psb_abort(ctxt) stop 1 endif if (inp_unit /= psb_inp_unit) then @@ -834,15 +834,15 @@ contains end if ! broadcast parameters to all processors - call psb_bcast(ictxt,kmethd) - call psb_bcast(ictxt,afmt) - call psb_bcast(ictxt,ptype) - call psb_bcast(ictxt,idim) - call psb_bcast(ictxt,ipart) - call psb_bcast(ictxt,istopc) - call psb_bcast(ictxt,itmax) - call psb_bcast(ictxt,itrace) - call psb_bcast(ictxt,irst) + call psb_bcast(ctxt,kmethd) + call psb_bcast(ctxt,afmt) + call psb_bcast(ctxt,ptype) + call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,ipart) + call psb_bcast(ctxt,istopc) + call psb_bcast(ctxt,itmax) + call psb_bcast(ctxt,itrace) + call psb_bcast(ctxt,irst) return diff --git a/test/serial/d_matgen.F90 b/test/serial/d_matgen.F90 index e96a1de9..5d6cd18e 100644 --- a/test/serial/d_matgen.F90 +++ b/test/serial/d_matgen.F90 @@ -34,7 +34,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine psb_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,& + subroutine psb_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,& & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,nrl,iv) use psb_base_mod ! @@ -58,7 +58,7 @@ contains type(psb_dspmat_type) :: a type(psb_d_vect_type) :: xv,bv type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: info character(len=*) :: afmt procedure(d_func_3d), optional :: f @@ -93,7 +93,7 @@ contains name = 'create_matrix' call psb_erractionsave(err_act) - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (present(f)) then @@ -126,30 +126,30 @@ contains end if nt = nr - call psb_sum(ictxt,nt) + call psb_sum(ctxt,nt) if (nt /= m) then write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if else if (size(iv) /= m) then write(psb_err_unit,*) iam, 'Initialization error IV',size(iv),m info = -1 - call psb_barrier(ictxt) - call psb_abort(ictxt) + call psb_barrier(ctxt) + call psb_abort(ctxt) return end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() if (present(iv)) then - call psb_cdall(ictxt,desc_a,info,vg=iv) + call psb_cdall(ctxt,desc_a,info,vg=iv) else - call psb_cdall(ictxt,desc_a,info,nl=nr) + call psb_cdall(ctxt,desc_a,info,nl=nr) end if if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) @@ -157,7 +157,7 @@ contains if (info == psb_success_) call psb_geall(xv,desc_a,info) if (info == psb_success_) call psb_geall(bv,desc_a,info) - call psb_barrier(ictxt) + call psb_barrier(ctxt) talc = psb_wtime()-t0 if (info /= psb_success_) then @@ -185,7 +185,7 @@ contains ! loop over rows belonging to current process in a block ! distribution. - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() do ii=1, nlr,nb ib = min(nb,nlr-ii+1) @@ -296,11 +296,11 @@ contains deallocate(val,irow,icol) - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() call psb_cdasb(desc_a,info,mold=imold) tcdasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (info == psb_success_) then if (present(amold)) then @@ -309,7 +309,7 @@ contains call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) end if end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='asb rout.' @@ -325,13 +325,13 @@ contains goto 9999 end if tasb = psb_wtime()-t1 - call psb_barrier(ictxt) + call psb_barrier(ctxt) ttot = psb_wtime() - t0 - call psb_amx(ictxt,talc) - call psb_amx(ictxt,tgen) - call psb_amx(ictxt,tasb) - call psb_amx(ictxt,ttot) + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) if(iam == psb_root_) then tmpfmt = a%get_fmt() write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& @@ -346,7 +346,7 @@ contains call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return end subroutine psb_d_gen_pde3d @@ -378,7 +378,7 @@ program d_matgen ! dense matrices type(psb_d_vect_type) :: b, x ! blacs parameters - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam, np ! solver parameters @@ -394,12 +394,12 @@ program d_matgen info=psb_success_ - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if (iam < 0) then ! This should not happen, but just in case - call psb_exit(ictxt) + call psb_exit(ctxt) stop endif if(psb_get_errstatus() /= 0) goto 9999 @@ -409,29 +409,29 @@ program d_matgen ! ! get parameters ! - call get_parms(ictxt,idim) + call get_parms(ctxt,idim) ! ! allocate and fill in the coefficient matrix, rhs and initial guess ! - call psb_barrier(ictxt) + call psb_barrier(ctxt) t1 = psb_wtime() if (.false.) then - call psb_gen_pde3d(ictxt,idim,a,b,x,desc_a,afmt,& + call psb_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& & a1,a2,a3,b1,b2,b3,c,g,info,amold=acsr) else if (.false.) then - call psb_gen_pde3d(ictxt,idim,a,b,x,desc_a,afmt,& + call psb_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& & a1,a2,a3,b1,b2,b3,c,g,info,amold=axyz) end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() - t1 - call psb_exit(ictxt) + call psb_exit(ctxt) stop -9999 call psb_error(ictxt) +9999 call psb_error(ctxt) stop @@ -439,13 +439,13 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ictxt,idim) - type(psb_ctxt_type) :: ictxt + subroutine get_parms(ctxt,idim) + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: idim integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: intbuf(10), ip - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) read(psb_inp_unit,*) idim diff --git a/test/torture/psb_c_mvsv_tester.f90 b/test/torture/psb_c_mvsv_tester.f90 index 468a0297..ed6a9423 100644 --- a/test/torture/psb_c_mvsv_tester.f90 +++ b/test/torture/psb_c_mvsv_tester.f90 @@ -1,13 +1,13 @@ module psb_c_mvsv_tester contains - subroutine c_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -34,17 +34,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -78,13 +78,13 @@ contains end subroutine c_usmv_2_n_ap3_bp1_ix1_iy1 ! - subroutine c_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -111,17 +111,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -155,13 +155,13 @@ contains end subroutine c_usmv_2_t_ap3_bp1_ix1_iy1 ! - subroutine c_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -188,17 +188,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -232,13 +232,13 @@ contains end subroutine c_usmv_2_c_ap3_bp1_ix1_iy1 ! - subroutine c_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -265,17 +265,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -309,13 +309,13 @@ contains end subroutine c_usmv_2_n_ap3_bm0_ix1_iy1 ! - subroutine c_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -342,17 +342,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -386,13 +386,13 @@ contains end subroutine c_usmv_2_t_ap3_bm0_ix1_iy1 ! - subroutine c_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -419,17 +419,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -463,13 +463,13 @@ contains end subroutine c_usmv_2_c_ap3_bm0_ix1_iy1 ! - subroutine c_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -496,17 +496,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -540,13 +540,13 @@ contains end subroutine c_usmv_2_n_ap1_bp1_ix1_iy1 ! - subroutine c_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -573,17 +573,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -617,13 +617,13 @@ contains end subroutine c_usmv_2_t_ap1_bp1_ix1_iy1 ! - subroutine c_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -650,17 +650,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -694,13 +694,13 @@ contains end subroutine c_usmv_2_c_ap1_bp1_ix1_iy1 ! - subroutine c_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -727,17 +727,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -771,13 +771,13 @@ contains end subroutine c_usmv_2_n_ap1_bm0_ix1_iy1 ! - subroutine c_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -804,17 +804,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -848,13 +848,13 @@ contains end subroutine c_usmv_2_t_ap1_bm0_ix1_iy1 ! - subroutine c_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -881,17 +881,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -925,13 +925,13 @@ contains end subroutine c_usmv_2_c_ap1_bm0_ix1_iy1 ! - subroutine c_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -958,17 +958,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1002,13 +1002,13 @@ contains end subroutine c_usmv_2_n_am1_bp1_ix1_iy1 ! - subroutine c_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1035,17 +1035,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1079,13 +1079,13 @@ contains end subroutine c_usmv_2_t_am1_bp1_ix1_iy1 ! - subroutine c_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1112,17 +1112,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1156,13 +1156,13 @@ contains end subroutine c_usmv_2_c_am1_bp1_ix1_iy1 ! - subroutine c_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1189,17 +1189,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1233,13 +1233,13 @@ contains end subroutine c_usmv_2_n_am1_bm0_ix1_iy1 ! - subroutine c_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1266,17 +1266,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1310,13 +1310,13 @@ contains end subroutine c_usmv_2_t_am1_bm0_ix1_iy1 ! - subroutine c_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1343,17 +1343,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1387,13 +1387,13 @@ contains end subroutine c_usmv_2_c_am1_bm0_ix1_iy1 ! - subroutine c_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1420,17 +1420,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1464,13 +1464,13 @@ contains end subroutine c_usmv_2_n_am3_bp1_ix1_iy1 ! - subroutine c_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1497,17 +1497,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1541,13 +1541,13 @@ contains end subroutine c_usmv_2_t_am3_bp1_ix1_iy1 ! - subroutine c_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1574,17 +1574,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1618,13 +1618,13 @@ contains end subroutine c_usmv_2_c_am3_bp1_ix1_iy1 ! - subroutine c_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1651,17 +1651,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1695,13 +1695,13 @@ contains end subroutine c_usmv_2_n_am3_bm0_ix1_iy1 ! - subroutine c_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1728,17 +1728,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1772,13 +1772,13 @@ contains end subroutine c_usmv_2_t_am3_bm0_ix1_iy1 ! - subroutine c_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1805,17 +1805,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1849,13 +1849,13 @@ contains end subroutine c_usmv_2_c_am3_bm0_ix1_iy1 ! - subroutine c_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1881,13 +1881,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1895,7 +1895,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1929,13 +1929,13 @@ contains end subroutine c_ussv_2_n_ap3_bm0_ix1_iy1 ! - subroutine c_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1961,13 +1961,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1975,7 +1975,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2009,13 +2009,13 @@ contains end subroutine c_ussv_2_t_ap3_bm0_ix1_iy1 ! - subroutine c_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2041,13 +2041,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2055,7 +2055,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2089,13 +2089,13 @@ contains end subroutine c_ussv_2_c_ap3_bm0_ix1_iy1 ! - subroutine c_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2121,13 +2121,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2135,7 +2135,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2169,13 +2169,13 @@ contains end subroutine c_ussv_2_n_ap1_bm0_ix1_iy1 ! - subroutine c_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2201,13 +2201,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2215,7 +2215,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2249,13 +2249,13 @@ contains end subroutine c_ussv_2_t_ap1_bm0_ix1_iy1 ! - subroutine c_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2281,13 +2281,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2295,7 +2295,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2329,13 +2329,13 @@ contains end subroutine c_ussv_2_c_ap1_bm0_ix1_iy1 ! - subroutine c_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2361,13 +2361,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2375,7 +2375,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2409,13 +2409,13 @@ contains end subroutine c_ussv_2_n_am1_bm0_ix1_iy1 ! - subroutine c_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2441,13 +2441,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2455,7 +2455,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2489,13 +2489,13 @@ contains end subroutine c_ussv_2_t_am1_bm0_ix1_iy1 ! - subroutine c_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2521,13 +2521,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2535,7 +2535,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2569,13 +2569,13 @@ contains end subroutine c_ussv_2_c_am1_bm0_ix1_iy1 ! - subroutine c_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2601,13 +2601,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2615,7 +2615,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2649,13 +2649,13 @@ contains end subroutine c_ussv_2_n_am3_bm0_ix1_iy1 ! - subroutine c_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2681,13 +2681,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2695,7 +2695,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2729,13 +2729,13 @@ contains end subroutine c_ussv_2_t_am3_bm0_ix1_iy1 ! - subroutine c_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine c_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2761,13 +2761,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2775,7 +2775,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) diff --git a/test/torture/psb_d_mvsv_tester.f90 b/test/torture/psb_d_mvsv_tester.f90 index c34bcf56..baabf216 100644 --- a/test/torture/psb_d_mvsv_tester.f90 +++ b/test/torture/psb_d_mvsv_tester.f90 @@ -2,13 +2,13 @@ module psb_d_mvsv_tester contains - subroutine d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -35,17 +35,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -79,13 +79,13 @@ contains end subroutine d_usmv_2_n_ap3_bp1_ix1_iy1 ! - subroutine d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -112,17 +112,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -156,13 +156,13 @@ contains end subroutine d_usmv_2_t_ap3_bp1_ix1_iy1 ! - subroutine d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -189,17 +189,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -233,13 +233,13 @@ contains end subroutine d_usmv_2_c_ap3_bp1_ix1_iy1 ! - subroutine d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -266,17 +266,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -310,13 +310,13 @@ contains end subroutine d_usmv_2_n_ap3_bm0_ix1_iy1 ! - subroutine d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -343,17 +343,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -387,13 +387,13 @@ contains end subroutine d_usmv_2_t_ap3_bm0_ix1_iy1 ! - subroutine d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -420,17 +420,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -464,13 +464,13 @@ contains end subroutine d_usmv_2_c_ap3_bm0_ix1_iy1 ! - subroutine d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -497,17 +497,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -541,13 +541,13 @@ contains end subroutine d_usmv_2_n_ap1_bp1_ix1_iy1 ! - subroutine d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -574,17 +574,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -618,13 +618,13 @@ contains end subroutine d_usmv_2_t_ap1_bp1_ix1_iy1 ! - subroutine d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -651,17 +651,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -695,13 +695,13 @@ contains end subroutine d_usmv_2_c_ap1_bp1_ix1_iy1 ! - subroutine d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -728,17 +728,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -772,13 +772,13 @@ contains end subroutine d_usmv_2_n_ap1_bm0_ix1_iy1 ! - subroutine d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -805,17 +805,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -849,13 +849,13 @@ contains end subroutine d_usmv_2_t_ap1_bm0_ix1_iy1 ! - subroutine d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -882,17 +882,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -926,13 +926,13 @@ contains end subroutine d_usmv_2_c_ap1_bm0_ix1_iy1 ! - subroutine d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -959,17 +959,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1003,13 +1003,13 @@ contains end subroutine d_usmv_2_n_am1_bp1_ix1_iy1 ! - subroutine d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1036,17 +1036,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1080,13 +1080,13 @@ contains end subroutine d_usmv_2_t_am1_bp1_ix1_iy1 ! - subroutine d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1113,17 +1113,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1157,13 +1157,13 @@ contains end subroutine d_usmv_2_c_am1_bp1_ix1_iy1 ! - subroutine d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1190,17 +1190,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1234,13 +1234,13 @@ contains end subroutine d_usmv_2_n_am1_bm0_ix1_iy1 ! - subroutine d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1267,17 +1267,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1311,13 +1311,13 @@ contains end subroutine d_usmv_2_t_am1_bm0_ix1_iy1 ! - subroutine d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1344,17 +1344,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1388,13 +1388,13 @@ contains end subroutine d_usmv_2_c_am1_bm0_ix1_iy1 ! - subroutine d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1421,17 +1421,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1465,13 +1465,13 @@ contains end subroutine d_usmv_2_n_am3_bp1_ix1_iy1 ! - subroutine d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1498,17 +1498,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1542,13 +1542,13 @@ contains end subroutine d_usmv_2_t_am3_bp1_ix1_iy1 ! - subroutine d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1575,17 +1575,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1619,13 +1619,13 @@ contains end subroutine d_usmv_2_c_am3_bp1_ix1_iy1 ! - subroutine d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1652,17 +1652,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1696,13 +1696,13 @@ contains end subroutine d_usmv_2_n_am3_bm0_ix1_iy1 ! - subroutine d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1729,17 +1729,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1773,13 +1773,13 @@ contains end subroutine d_usmv_2_t_am3_bm0_ix1_iy1 ! - subroutine d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1806,17 +1806,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1850,13 +1850,13 @@ contains end subroutine d_usmv_2_c_am3_bm0_ix1_iy1 ! - subroutine d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1882,13 +1882,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1896,7 +1896,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1930,13 +1930,13 @@ contains end subroutine d_ussv_2_n_ap3_bm0_ix1_iy1 ! - subroutine d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1962,13 +1962,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1976,7 +1976,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2010,13 +2010,13 @@ contains end subroutine d_ussv_2_t_ap3_bm0_ix1_iy1 ! - subroutine d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2042,13 +2042,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2056,7 +2056,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2090,13 +2090,13 @@ contains end subroutine d_ussv_2_c_ap3_bm0_ix1_iy1 ! - subroutine d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2122,13 +2122,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2136,7 +2136,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2170,13 +2170,13 @@ contains end subroutine d_ussv_2_n_ap1_bm0_ix1_iy1 ! - subroutine d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2202,13 +2202,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2216,7 +2216,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2250,13 +2250,13 @@ contains end subroutine d_ussv_2_t_ap1_bm0_ix1_iy1 ! - subroutine d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2282,13 +2282,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2296,7 +2296,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2330,13 +2330,13 @@ contains end subroutine d_ussv_2_c_ap1_bm0_ix1_iy1 ! - subroutine d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2362,13 +2362,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2376,7 +2376,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2410,13 +2410,13 @@ contains end subroutine d_ussv_2_n_am1_bm0_ix1_iy1 ! - subroutine d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2442,13 +2442,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2456,7 +2456,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2490,13 +2490,13 @@ contains end subroutine d_ussv_2_t_am1_bm0_ix1_iy1 ! - subroutine d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2522,13 +2522,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2536,7 +2536,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2570,13 +2570,13 @@ contains end subroutine d_ussv_2_c_am1_bm0_ix1_iy1 ! - subroutine d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2602,13 +2602,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2616,7 +2616,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2650,13 +2650,13 @@ contains end subroutine d_ussv_2_n_am3_bm0_ix1_iy1 ! - subroutine d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2682,13 +2682,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2696,7 +2696,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2730,13 +2730,13 @@ contains end subroutine d_ussv_2_t_am3_bm0_ix1_iy1 ! - subroutine d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2762,13 +2762,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2776,7 +2776,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) diff --git a/test/torture/psb_s_mvsv_tester.f90 b/test/torture/psb_s_mvsv_tester.f90 index 7330df18..34c1e9eb 100644 --- a/test/torture/psb_s_mvsv_tester.f90 +++ b/test/torture/psb_s_mvsv_tester.f90 @@ -1,12 +1,12 @@ module psb_s_mvsv_tester contains - subroutine s_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -33,17 +33,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -77,13 +77,13 @@ contains end subroutine s_usmv_2_n_ap3_bp1_ix1_iy1 ! - subroutine s_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -110,17 +110,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -154,13 +154,13 @@ contains end subroutine s_usmv_2_t_ap3_bp1_ix1_iy1 ! - subroutine s_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -187,17 +187,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -231,13 +231,13 @@ contains end subroutine s_usmv_2_c_ap3_bp1_ix1_iy1 ! - subroutine s_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -264,17 +264,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -308,13 +308,13 @@ contains end subroutine s_usmv_2_n_ap3_bm0_ix1_iy1 ! - subroutine s_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -341,17 +341,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -385,13 +385,13 @@ contains end subroutine s_usmv_2_t_ap3_bm0_ix1_iy1 ! - subroutine s_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -418,17 +418,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -462,13 +462,13 @@ contains end subroutine s_usmv_2_c_ap3_bm0_ix1_iy1 ! - subroutine s_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -495,17 +495,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -539,13 +539,13 @@ contains end subroutine s_usmv_2_n_ap1_bp1_ix1_iy1 ! - subroutine s_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -572,17 +572,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -616,13 +616,13 @@ contains end subroutine s_usmv_2_t_ap1_bp1_ix1_iy1 ! - subroutine s_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -649,17 +649,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -693,13 +693,13 @@ contains end subroutine s_usmv_2_c_ap1_bp1_ix1_iy1 ! - subroutine s_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -726,17 +726,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -770,13 +770,13 @@ contains end subroutine s_usmv_2_n_ap1_bm0_ix1_iy1 ! - subroutine s_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -803,17 +803,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -847,13 +847,13 @@ contains end subroutine s_usmv_2_t_ap1_bm0_ix1_iy1 ! - subroutine s_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -880,17 +880,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -924,13 +924,13 @@ contains end subroutine s_usmv_2_c_ap1_bm0_ix1_iy1 ! - subroutine s_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -957,17 +957,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1001,13 +1001,13 @@ contains end subroutine s_usmv_2_n_am1_bp1_ix1_iy1 ! - subroutine s_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1034,17 +1034,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1078,13 +1078,13 @@ contains end subroutine s_usmv_2_t_am1_bp1_ix1_iy1 ! - subroutine s_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1111,17 +1111,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1155,13 +1155,13 @@ contains end subroutine s_usmv_2_c_am1_bp1_ix1_iy1 ! - subroutine s_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1188,17 +1188,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1232,13 +1232,13 @@ contains end subroutine s_usmv_2_n_am1_bm0_ix1_iy1 ! - subroutine s_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1265,17 +1265,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1309,13 +1309,13 @@ contains end subroutine s_usmv_2_t_am1_bm0_ix1_iy1 ! - subroutine s_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1342,17 +1342,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1386,13 +1386,13 @@ contains end subroutine s_usmv_2_c_am1_bm0_ix1_iy1 ! - subroutine s_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1419,17 +1419,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1463,13 +1463,13 @@ contains end subroutine s_usmv_2_n_am3_bp1_ix1_iy1 ! - subroutine s_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1496,17 +1496,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1540,13 +1540,13 @@ contains end subroutine s_usmv_2_t_am3_bp1_ix1_iy1 ! - subroutine s_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1573,17 +1573,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1617,13 +1617,13 @@ contains end subroutine s_usmv_2_c_am3_bp1_ix1_iy1 ! - subroutine s_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1650,17 +1650,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1694,13 +1694,13 @@ contains end subroutine s_usmv_2_n_am3_bm0_ix1_iy1 ! - subroutine s_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1727,17 +1727,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1771,13 +1771,13 @@ contains end subroutine s_usmv_2_t_am3_bm0_ix1_iy1 ! - subroutine s_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1804,17 +1804,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1848,13 +1848,13 @@ contains end subroutine s_usmv_2_c_am3_bm0_ix1_iy1 ! - subroutine s_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1880,20 +1880,20 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 call a%set_triangle() call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1927,13 +1927,13 @@ contains end subroutine s_ussv_2_n_ap3_bm0_ix1_iy1 ! - subroutine s_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1959,13 +1959,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1973,7 +1973,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2007,13 +2007,13 @@ contains end subroutine s_ussv_2_t_ap3_bm0_ix1_iy1 ! - subroutine s_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2039,13 +2039,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2053,7 +2053,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2087,13 +2087,13 @@ contains end subroutine s_ussv_2_c_ap3_bm0_ix1_iy1 ! - subroutine s_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2119,13 +2119,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2133,7 +2133,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2167,13 +2167,13 @@ contains end subroutine s_ussv_2_n_ap1_bm0_ix1_iy1 ! - subroutine s_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2199,13 +2199,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2213,7 +2213,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2247,13 +2247,13 @@ contains end subroutine s_ussv_2_t_ap1_bm0_ix1_iy1 ! - subroutine s_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2279,13 +2279,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2293,7 +2293,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2327,13 +2327,13 @@ contains end subroutine s_ussv_2_c_ap1_bm0_ix1_iy1 ! - subroutine s_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2359,13 +2359,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2373,7 +2373,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2407,13 +2407,13 @@ contains end subroutine s_ussv_2_n_am1_bm0_ix1_iy1 ! - subroutine s_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2439,13 +2439,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2453,7 +2453,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2487,13 +2487,13 @@ contains end subroutine s_ussv_2_t_am1_bm0_ix1_iy1 ! - subroutine s_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2519,13 +2519,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2533,7 +2533,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2567,13 +2567,13 @@ contains end subroutine s_ussv_2_c_am1_bm0_ix1_iy1 ! - subroutine s_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2599,13 +2599,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2613,7 +2613,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2647,13 +2647,13 @@ contains end subroutine s_ussv_2_n_am3_bm0_ix1_iy1 ! - subroutine s_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2679,13 +2679,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2693,7 +2693,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2727,13 +2727,13 @@ contains end subroutine s_ussv_2_t_am3_bm0_ix1_iy1 ! - subroutine s_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine s_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2759,13 +2759,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2773,7 +2773,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) diff --git a/test/torture/psb_z_mvsv_tester.f90 b/test/torture/psb_z_mvsv_tester.f90 index d3fda477..bc84a447 100644 --- a/test/torture/psb_z_mvsv_tester.f90 +++ b/test/torture/psb_z_mvsv_tester.f90 @@ -1,13 +1,13 @@ module psb_z_mvsv_tester contains - subroutine z_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -34,17 +34,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -78,13 +78,13 @@ contains end subroutine z_usmv_2_n_ap3_bp1_ix1_iy1 ! - subroutine z_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -111,17 +111,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -155,13 +155,13 @@ contains end subroutine z_usmv_2_t_ap3_bp1_ix1_iy1 ! - subroutine z_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -188,17 +188,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -232,13 +232,13 @@ contains end subroutine z_usmv_2_c_ap3_bp1_ix1_iy1 ! - subroutine z_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -265,17 +265,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -309,13 +309,13 @@ contains end subroutine z_usmv_2_n_ap3_bm0_ix1_iy1 ! - subroutine z_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -342,17 +342,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -386,13 +386,13 @@ contains end subroutine z_usmv_2_t_ap3_bm0_ix1_iy1 ! - subroutine z_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -419,17 +419,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -463,13 +463,13 @@ contains end subroutine z_usmv_2_c_ap3_bm0_ix1_iy1 ! - subroutine z_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -496,17 +496,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -540,13 +540,13 @@ contains end subroutine z_usmv_2_n_ap1_bp1_ix1_iy1 ! - subroutine z_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -573,17 +573,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -617,13 +617,13 @@ contains end subroutine z_usmv_2_t_ap1_bp1_ix1_iy1 ! - subroutine z_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -650,17 +650,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -694,13 +694,13 @@ contains end subroutine z_usmv_2_c_ap1_bp1_ix1_iy1 ! - subroutine z_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -727,17 +727,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -771,13 +771,13 @@ contains end subroutine z_usmv_2_n_ap1_bm0_ix1_iy1 ! - subroutine z_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -804,17 +804,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -848,13 +848,13 @@ contains end subroutine z_usmv_2_t_ap1_bm0_ix1_iy1 ! - subroutine z_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -881,17 +881,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -925,13 +925,13 @@ contains end subroutine z_usmv_2_c_ap1_bm0_ix1_iy1 ! - subroutine z_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -958,17 +958,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1002,13 +1002,13 @@ contains end subroutine z_usmv_2_n_am1_bp1_ix1_iy1 ! - subroutine z_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1035,17 +1035,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1079,13 +1079,13 @@ contains end subroutine z_usmv_2_t_am1_bp1_ix1_iy1 ! - subroutine z_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1112,17 +1112,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1156,13 +1156,13 @@ contains end subroutine z_usmv_2_c_am1_bp1_ix1_iy1 ! - subroutine z_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1189,17 +1189,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1233,13 +1233,13 @@ contains end subroutine z_usmv_2_n_am1_bm0_ix1_iy1 ! - subroutine z_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1266,17 +1266,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1310,13 +1310,13 @@ contains end subroutine z_usmv_2_t_am1_bm0_ix1_iy1 ! - subroutine z_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1343,17 +1343,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1387,13 +1387,13 @@ contains end subroutine z_usmv_2_c_am1_bm0_ix1_iy1 ! - subroutine z_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1420,17 +1420,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1464,13 +1464,13 @@ contains end subroutine z_usmv_2_n_am3_bp1_ix1_iy1 ! - subroutine z_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1497,17 +1497,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1541,13 +1541,13 @@ contains end subroutine z_usmv_2_t_am3_bp1_ix1_iy1 ! - subroutine z_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1574,17 +1574,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1618,13 +1618,13 @@ contains end subroutine z_usmv_2_c_am3_bp1_ix1_iy1 ! - subroutine z_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1651,17 +1651,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1695,13 +1695,13 @@ contains end subroutine z_usmv_2_n_am3_bm0_ix1_iy1 ! - subroutine z_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1728,17 +1728,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1772,13 +1772,13 @@ contains end subroutine z_usmv_2_t_am3_bm0_ix1_iy1 ! - subroutine z_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1805,17 +1805,17 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1849,13 +1849,13 @@ contains end subroutine z_usmv_2_c_am3_bm0_ix1_iy1 ! - subroutine z_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1881,13 +1881,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1895,7 +1895,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -1929,13 +1929,13 @@ contains end subroutine z_ussv_2_n_ap3_bm0_ix1_iy1 ! - subroutine z_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -1961,13 +1961,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -1975,7 +1975,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2009,13 +2009,13 @@ contains end subroutine z_ussv_2_t_ap3_bm0_ix1_iy1 ! - subroutine z_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2041,13 +2041,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2055,7 +2055,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2089,13 +2089,13 @@ contains end subroutine z_ussv_2_c_ap3_bm0_ix1_iy1 ! - subroutine z_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2121,13 +2121,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2135,7 +2135,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2169,13 +2169,13 @@ contains end subroutine z_ussv_2_n_ap1_bm0_ix1_iy1 ! - subroutine z_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2201,13 +2201,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2215,7 +2215,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2249,13 +2249,13 @@ contains end subroutine z_ussv_2_t_ap1_bm0_ix1_iy1 ! - subroutine z_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2281,13 +2281,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2295,7 +2295,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2329,13 +2329,13 @@ contains end subroutine z_ussv_2_c_ap1_bm0_ix1_iy1 ! - subroutine z_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2361,13 +2361,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2375,7 +2375,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2409,13 +2409,13 @@ contains end subroutine z_ussv_2_n_am1_bm0_ix1_iy1 ! - subroutine z_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2441,13 +2441,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2455,7 +2455,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2489,13 +2489,13 @@ contains end subroutine z_ussv_2_t_am1_bm0_ix1_iy1 ! - subroutine z_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2521,13 +2521,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2535,7 +2535,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2569,13 +2569,13 @@ contains end subroutine z_ussv_2_c_am1_bm0_ix1_iy1 ! - subroutine z_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2601,13 +2601,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2615,7 +2615,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2649,13 +2649,13 @@ contains end subroutine z_ussv_2_n_am3_bm0_ix1_iy1 ! - subroutine z_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2681,13 +2681,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2695,7 +2695,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) @@ -2729,13 +2729,13 @@ contains end subroutine z_ussv_2_t_am3_bm0_ix1_iy1 ! - subroutine z_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + subroutine z_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) use psb_base_mod implicit none character(len=*) :: afmt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: iam=-1, np=-1 integer(psb_ipk_) :: info=-1 @@ -2761,13 +2761,13 @@ contains y=bcy res=0 - call psb_info(ictxt,iam,np) + call psb_info(ctxt,iam,np) if(iam<0)then info=-1 goto 9999 endif - call psb_barrier(ictxt) - call psb_cdall(ictxt,desc_a,info,nl=m) + call psb_barrier(ctxt) + call psb_cdall(ctxt,desc_a,info,nl=m) if (info /= psb_success_)goto 9996 call psb_spall(a,desc_a,info,nnz=nnz) if (info /= psb_success_)goto 9996 @@ -2775,7 +2775,7 @@ contains call a%set_lower() call a%set_unit(.false.) - call psb_barrier(ictxt) + call psb_barrier(ctxt) call psb_spins(nnz,IA,JA,VA,a,desc_a,info) if (info /= psb_success_)goto 9996 call psb_cdasb(desc_a,info) diff --git a/test/torture/psbtf.f90 b/test/torture/psbtf.f90 index 886bcb07..35851ada 100644 --- a/test/torture/psbtf.f90 +++ b/test/torture/psbtf.f90 @@ -11,734 +11,734 @@ program main implicit none integer(psb_ipk_), parameter :: psb_fidasize_=16 integer(psb_ipk_) :: res,passed=0,failed=0; - integer(psb_ipk_) :: ictxt, iam=-1, np=-1 + integer(psb_ipk_) :: ctxt, iam=-1, np=-1 character(len=psb_fidasize_) :: afmt write(psb_out_unit,*) 'Format ?' read(psb_inp_unit,*) afmt ! afmt = 'COO' - call psb_init(ictxt) - call psb_info(ictxt,iam,np) + call psb_init(ctxt) + call psb_info(ctxt,iam,np) if(iam<0)then goto 9999 endif - call s_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call s_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call s_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call s_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call c_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call c_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call c_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call z_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 - call z_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ictxt) + call z_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt) if(res /= 0)failed=failed+1 if(res.eq.0)passed=passed+1 res=0 @@ -746,7 +746,7 @@ program main 9999 continue print *,"PASSED:",passed print *,"FAILED:",failed - call psb_exit(ictxt) + call psb_exit(ctxt) end program main diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 index 2e57e4f8..970dfc47 100644 --- a/util/psb_c_mat_dist_impl.f90 +++ b/util/psb_c_mat_dist_impl.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -59,7 +59,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -75,7 +75,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_cspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -110,7 +110,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) use_parts = present(parts) use_vg = present(vg) @@ -140,10 +140,10 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -156,11 +156,11 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -269,12 +269,12 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -282,8 +282,8 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -296,10 +296,10 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) call psb_spins(ll,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -319,7 +319,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -330,7 +330,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -362,7 +362,7 @@ subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -370,7 +370,7 @@ end subroutine psb_cmatdist -subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -400,7 +400,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -416,7 +416,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_lcspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -452,7 +452,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -476,10 +476,10 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -492,11 +492,11 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -607,12 +607,12 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -620,8 +620,8 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -634,10 +634,10 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) il = ll call psb_spins(il,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then @@ -658,7 +658,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -669,7 +669,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -701,7 +701,7 @@ subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/util/psb_c_mat_dist_mod.f90 b/util/psb_c_mat_dist_mod.f90 index 8a435e70..de48dabf 100644 --- a/util/psb_c_mat_dist_mod.f90 +++ b/util/psb_c_mat_dist_mod.f90 @@ -35,7 +35,7 @@ module psb_c_mat_dist_mod & psb_lcspmat_type, psb_ctxt_type interface psb_matdist - subroutine psb_cmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_cmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -65,7 +65,7 @@ module psb_c_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -81,7 +81,7 @@ module psb_c_mat_dist_mod ! parameters type(psb_cspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -92,7 +92,7 @@ module psb_c_mat_dist_mod integer(psb_ipk_), optional :: vg(:) integer(psb_ipk_), optional :: vsz(:) end subroutine psb_cmatdist - subroutine psb_lcmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_lcmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -122,7 +122,7 @@ module psb_c_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -138,7 +138,7 @@ module psb_c_mat_dist_mod ! parameters type(psb_lcspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_cspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 index 0dbc4682..c71141f0 100644 --- a/util/psb_d_mat_dist_impl.f90 +++ b/util/psb_d_mat_dist_impl.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -59,7 +59,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -75,7 +75,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_dspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -110,7 +110,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) use_parts = present(parts) use_vg = present(vg) @@ -140,10 +140,10 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -156,11 +156,11 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -269,12 +269,12 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -282,8 +282,8 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -296,10 +296,10 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) call psb_spins(ll,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -319,7 +319,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -330,7 +330,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -362,7 +362,7 @@ subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -370,7 +370,7 @@ end subroutine psb_dmatdist -subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -400,7 +400,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -416,7 +416,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_ldspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -452,7 +452,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -476,10 +476,10 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -492,11 +492,11 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -607,12 +607,12 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -620,8 +620,8 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -634,10 +634,10 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) il = ll call psb_spins(il,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then @@ -658,7 +658,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -669,7 +669,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -701,7 +701,7 @@ subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/util/psb_d_mat_dist_mod.f90 b/util/psb_d_mat_dist_mod.f90 index a1ed3a7c..2c7f9290 100644 --- a/util/psb_d_mat_dist_mod.f90 +++ b/util/psb_d_mat_dist_mod.f90 @@ -35,7 +35,7 @@ module psb_d_mat_dist_mod & psb_ldspmat_type, psb_ctxt_type interface psb_matdist - subroutine psb_dmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_dmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -65,7 +65,7 @@ module psb_d_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -81,7 +81,7 @@ module psb_d_mat_dist_mod ! parameters type(psb_dspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -92,7 +92,7 @@ module psb_d_mat_dist_mod integer(psb_ipk_), optional :: vg(:) integer(psb_ipk_), optional :: vsz(:) end subroutine psb_dmatdist - subroutine psb_ldmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_ldmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -122,7 +122,7 @@ module psb_d_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -138,7 +138,7 @@ module psb_d_mat_dist_mod ! parameters type(psb_ldspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_dspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index f1c7195d..69dae5a8 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -45,7 +45,7 @@ ! integer(psb_ipk_) :: NPARTS How many parts we are requiring to the ! partition utility ! -! DISTR_MTPART(ROOT,ICTXT): This subroutine will be called by +! DISTR_MTPART(ROOT,ctxt): This subroutine will be called by ! all processes to distribute the information computed by the root ! process, to be used subsequently. ! @@ -112,20 +112,20 @@ contains end subroutine part_graph - subroutine distr_mtpart(root, ictxt) + subroutine distr_mtpart(root, ctxt) use psb_base_mod implicit none - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: root integer(psb_ipk_) :: me, np, info integer(psb_lpk_) :: n - call psb_info(ictxt,me,np) + call psb_info(ctxt,me,np) if (.not.((root>=0).and.(root1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -75,7 +75,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_sspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -110,7 +110,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) use_parts = present(parts) use_vg = present(vg) @@ -140,10 +140,10 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -156,11 +156,11 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -269,12 +269,12 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -282,8 +282,8 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -296,10 +296,10 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) call psb_spins(ll,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -319,7 +319,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -330,7 +330,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -362,7 +362,7 @@ subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -370,7 +370,7 @@ end subroutine psb_smatdist -subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -400,7 +400,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -416,7 +416,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_lsspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -452,7 +452,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -476,10 +476,10 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -492,11 +492,11 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -607,12 +607,12 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -620,8 +620,8 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -634,10 +634,10 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) il = ll call psb_spins(il,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then @@ -658,7 +658,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -669,7 +669,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -701,7 +701,7 @@ subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/util/psb_s_mat_dist_mod.f90 b/util/psb_s_mat_dist_mod.f90 index c1ae8cc5..47f6381f 100644 --- a/util/psb_s_mat_dist_mod.f90 +++ b/util/psb_s_mat_dist_mod.f90 @@ -35,7 +35,7 @@ module psb_s_mat_dist_mod & psb_lsspmat_type, psb_ctxt_type interface psb_matdist - subroutine psb_smatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_smatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -65,7 +65,7 @@ module psb_s_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -81,7 +81,7 @@ module psb_s_mat_dist_mod ! parameters type(psb_sspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -92,7 +92,7 @@ module psb_s_mat_dist_mod integer(psb_ipk_), optional :: vg(:) integer(psb_ipk_), optional :: vsz(:) end subroutine psb_smatdist - subroutine psb_lsmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_lsmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -122,7 +122,7 @@ module psb_s_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -138,7 +138,7 @@ module psb_s_mat_dist_mod ! parameters type(psb_lsspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_sspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 index 770e3527..2768b21e 100644 --- a/util/psb_z_mat_dist_impl.f90 +++ b/util/psb_z_mat_dist_impl.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -59,7 +59,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -75,7 +75,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_zspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -110,7 +110,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) use_parts = present(parts) use_vg = present(vg) @@ -140,10 +140,10 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -156,11 +156,11 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -269,12 +269,12 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -282,8 +282,8 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -296,10 +296,10 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) call psb_spins(ll,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then info=psb_err_from_subroutine_ @@ -319,7 +319,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -330,7 +330,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -362,7 +362,7 @@ subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return @@ -370,7 +370,7 @@ end subroutine psb_zmatdist -subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& +subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -400,7 +400,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -416,7 +416,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& ! parameters type(psb_lzspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -452,7 +452,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& else root = psb_root_ end if - call psb_info(ictxt, iam, np) + call psb_info(ctxt, iam, np) if (iam == root) then nrow = a_glob%get_nrows() ncol = a_glob%get_ncols() @@ -476,10 +476,10 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& endif ! broadcast informations to other processors - call psb_bcast(ictxt,nrow, root) - call psb_bcast(ictxt,ncol, root) - call psb_bcast(ictxt,nnzero, root) - call psb_bcast(ictxt,nrhs, root) + call psb_bcast(ctxt,nrow, root) + call psb_bcast(ctxt,ncol, root) + call psb_bcast(ctxt,nnzero, root) + call psb_bcast(ctxt,nrhs, root) liwork = max(np, nrow + ncol) allocate(iwork(liwork), iwrk2(np),stat = info) if (info /= psb_success_) then @@ -492,11 +492,11 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& &nrow, ncol, nnzero,nrhs endif if (use_parts) then - call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + call psb_cdall(ctxt,desc_a,info,mg=nrow,parts=parts) else if (use_vg) then - call psb_cdall(ictxt,desc_a,info,vg=vg) + call psb_cdall(ctxt,desc_a,info,vg=vg) else if (use_vsz) then - call psb_cdall(ictxt,desc_a,info,nl=vsz(iam+1)) + call psb_cdall(ctxt,desc_a,info,nl=vsz(iam+1)) else info = -1 end if @@ -607,12 +607,12 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if else - call psb_snd(ictxt,nnr,iproc) - call psb_snd(ictxt,ll,iproc) - call psb_snd(ictxt,irow(1:ll),iproc) - call psb_snd(ictxt,icol(1:ll),iproc) - call psb_snd(ictxt,val(1:ll),iproc) - call psb_rcv(ictxt,ll,iproc) + call psb_snd(ctxt,nnr,iproc) + call psb_snd(ctxt,ll,iproc) + call psb_snd(ctxt,irow(1:ll),iproc) + call psb_snd(ctxt,icol(1:ll),iproc) + call psb_snd(ctxt,val(1:ll),iproc) + call psb_rcv(ctxt,ll,iproc) endif end do else if (iam /= root) then @@ -620,8 +620,8 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& do k_count = 1, np_sharing iproc = iwork(k_count) if (iproc == iam) then - call psb_rcv(ictxt,nnr,root) - call psb_rcv(ictxt,ll,root) + call psb_rcv(ctxt,nnr,root) + call psb_rcv(ctxt,ll,root) if (ll > size(irow)) then write(psb_err_unit,*) iam,'need to reallocate ',ll deallocate(val,irow,icol) @@ -634,10 +634,10 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& end if endif - call psb_rcv(ictxt,irow(1:ll),root) - call psb_rcv(ictxt,icol(1:ll),root) - call psb_rcv(ictxt,val(1:ll),root) - call psb_snd(ictxt,ll,root) + call psb_rcv(ctxt,irow(1:ll),root) + call psb_rcv(ctxt,icol(1:ll),root) + call psb_rcv(ctxt,val(1:ll),root) + call psb_snd(ctxt,ll,root) il = ll call psb_spins(il,irow,icol,val,a,desc_a,info) if(info /= psb_success_) then @@ -658,7 +658,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& end if end do - call psb_barrier(ictxt) + call psb_barrier(ctxt) t0 = psb_wtime() call psb_cdasb(desc_a,info) t1 = psb_wtime() @@ -669,7 +669,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& goto 9999 end if - call psb_barrier(ictxt) + call psb_barrier(ctxt) t2 = psb_wtime() call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) t3 = psb_wtime() @@ -701,7 +701,7 @@ subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& call psb_erractionrestore(err_act) return -9999 call psb_error_handler(ictxt,err_act) +9999 call psb_error_handler(ctxt,err_act) return diff --git a/util/psb_z_mat_dist_mod.f90 b/util/psb_z_mat_dist_mod.f90 index f34e09f3..2f62899e 100644 --- a/util/psb_z_mat_dist_mod.f90 +++ b/util/psb_z_mat_dist_mod.f90 @@ -35,7 +35,7 @@ module psb_z_mat_dist_mod & psb_lzspmat_type, psb_ctxt_type interface psb_matdist - subroutine psb_zmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_zmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -65,7 +65,7 @@ module psb_z_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -81,7 +81,7 @@ module psb_z_mat_dist_mod ! parameters type(psb_zspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info @@ -92,7 +92,7 @@ module psb_z_mat_dist_mod integer(psb_ipk_), optional :: vg(:) integer(psb_ipk_), optional :: vsz(:) end subroutine psb_zmatdist - subroutine psb_lzmatdist(a_glob, a, ictxt, desc_a,& + subroutine psb_lzmatdist(a_glob, a, ctxt, desc_a,& & info, parts, vg, vsz, inroot,fmt,mold) ! ! an utility subroutine to distribute a matrix among processors @@ -122,7 +122,7 @@ module psb_z_mat_dist_mod ! usually nv=1; if nv >1 then we have an overlap in the data ! distribution. ! - ! integer(psb_ipk_) :: ictxt + ! integer(psb_ipk_) :: ctxt ! on entry: the PSBLAS parallel environment context. ! ! type (desc_type) :: desc_a @@ -138,7 +138,7 @@ module psb_z_mat_dist_mod ! parameters type(psb_lzspmat_type) :: a_glob - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt type(psb_zspmat_type) :: a type(psb_desc_type) :: desc_a integer(psb_ipk_), intent(out) :: info From 02b9ff5cfb3afa0e07c13078974d827e5b2e4be2 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 16 Nov 2020 16:16:00 +0100 Subject: [PATCH 07/12] Fix Makefile dependencies --- base/modules/Makefile | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/base/modules/Makefile b/base/modules/Makefile index 4d01299f..31c509ad 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -162,10 +162,15 @@ penv/psi_d_collective_mod.o penv/psi_c_collective_mod.o penv/psi_z_collective_m penv/psi_d_p2p_mod.o penv/psi_c_p2p_mod.o penv/psi_z_p2p_mod.o -auxil/psb_string_mod.o desc/psb_desc_const_mod.o psi_penv_mod.o: psb_const_mod.o +auxil/psb_string_mod.o auxil/psb_m_realloc_mod.o auxil/psb_e_realloc_mod.o auxil/psb_s_realloc_mod.o \ +auxil/psb_d_realloc_mod.o auxil/psb_c_realloc_mod.o auxil/psb_z_realloc_mod.o \ +desc/psb_desc_const_mod.o psi_penv_mod.o: psb_const_mod.o + + desc/psb_indx_map_mod.o desc/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o desc/psb_desc_const_mod.o auxil/psb_i_sort_mod.o auxil/psb_s_sort_mod.o auxil/psb_d_sort_mod.o auxil/psb_c_sort_mod.o auxil/psb_z_sort_mod.o \ auxil/psb_ip_reord_mod.o auxil/psi_serial_mod.o auxil/psb_sort_mod.o: $(BASIC_MODS) + auxil/psb_sort_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \ auxil/psb_m_msort_mod.o auxil/psb_m_qsort_mod.o \ auxil/psb_e_hsort_mod.o auxil/psb_e_isort_mod.o \ @@ -186,6 +191,28 @@ auxil/psb_sort_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \ auxil/psb_z_hsort_x_mod.o \ auxil/psb_ip_reord_mod.o auxil/psi_serial_mod.o +auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \ +auxil/psb_m_msort_mod.o auxil/psb_m_qsort_mod.o \ +auxil/psb_e_hsort_mod.o auxil/psb_e_isort_mod.o \ +auxil/psb_e_msort_mod.o auxil/psb_e_qsort_mod.o \ +auxil/psb_s_hsort_mod.o auxil/psb_s_isort_mod.o \ +auxil/psb_s_msort_mod.o auxil/psb_s_qsort_mod.o \ +auxil/psb_d_hsort_mod.o auxil/psb_d_isort_mod.o \ +auxil/psb_d_msort_mod.o auxil/psb_d_qsort_mod.o \ +auxil/psb_c_hsort_mod.o auxil/psb_c_isort_mod.o \ +auxil/psb_c_msort_mod.o auxil/psb_c_qsort_mod.o \ +auxil/psb_z_hsort_mod.o auxil/psb_z_isort_mod.o \ +auxil/psb_z_msort_mod.o auxil/psb_z_qsort_mod.o \ +auxil/psb_i_hsort_x_mod.o \ +auxil/psb_l_hsort_x_mod.o \ +auxil/psb_s_hsort_x_mod.o \ +auxil/psb_d_hsort_x_mod.o \ +auxil/psb_c_hsort_x_mod.o \ +auxil/psb_z_hsort_x_mod.o \ +auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \ +auxil/psb_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \ +auxil/psb_c_ip_reord_mod.o auxil/psb_z_ip_reord_mod.o : psb_realloc_mod.o psb_const_mod.o + auxil/psb_i_hsort_x_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_e_hsort_mod.o auxil/psb_l_hsort_x_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_e_hsort_mod.o From 5f67cc4bb52f16e87ffd9cfa09d116640f4555d9 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 16 Nov 2020 16:16:11 +0100 Subject: [PATCH 08/12] new context in CBIND --- cbind/base/psb_base_tools_cbind_mod.F90 | 25 +++--- cbind/base/psb_cpenv_mod.f90 | 102 +++++++++++++----------- cbind/prec/psb_cprec_cbind_mod.f90 | 8 +- cbind/prec/psb_dprec_cbind_mod.f90 | 8 +- cbind/prec/psb_sprec_cbind_mod.f90 | 8 +- cbind/prec/psb_zprec_cbind_mod.f90 | 8 +- 6 files changed, 84 insertions(+), 75 deletions(-) diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index b102477a..cc69d9d7 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -23,18 +23,18 @@ contains call psb_clean_errstack() end function psb_c_clean_errstack - function psb_c_cdall_vg(ng,vg,ictxt,cdh) bind(c,name='psb_c_cdall_vg') result(res) + function psb_c_cdall_vg(ng,vg,cctxt,cdh) bind(c,name='psb_c_cdall_vg') result(res) implicit none integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: ng - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt integer(psb_c_ipk_) :: vg(*) type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (ng <=0) then @@ -59,17 +59,17 @@ contains end function psb_c_cdall_vg - function psb_c_cdall_vl(nl,vl,ictxt,cdh) bind(c,name='psb_c_cdall_vl') result(res) + function psb_c_cdall_vl(nl,vl,cctxt,cdh) bind(c,name='psb_c_cdall_vl') result(res) implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: nl, ictxt + integer(psb_c_ipk_), value :: nl, cctxt integer(psb_c_lpk_) :: vl(*) type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info, ixb type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (nl <=0) then @@ -99,16 +99,16 @@ contains end function psb_c_cdall_vl - function psb_c_cdall_nl(nl,ictxt,cdh) bind(c,name='psb_c_cdall_nl') result(res) + function psb_c_cdall_nl(nl,cctxt,cdh) bind(c,name='psb_c_cdall_nl') result(res) implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: nl, ictxt + integer(psb_c_ipk_), value :: nl, cctxt type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (nl <=0) then @@ -132,17 +132,18 @@ contains end function psb_c_cdall_nl - function psb_c_cdall_repl(n,ictxt,cdh) bind(c,name='psb_c_cdall_repl') result(res) + function psb_c_cdall_repl(n,cctxt,cdh) bind(c,name='psb_c_cdall_repl') result(res) implicit none integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: n - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) + res = -1 if (n <=0) then diff --git a/cbind/base/psb_cpenv_mod.f90 b/cbind/base/psb_cpenv_mod.f90 index 1814303d..ad5bfcfe 100644 --- a/cbind/base/psb_cpenv_mod.f90 +++ b/cbind/base/psb_cpenv_mod.f90 @@ -34,63 +34,62 @@ contains use psb_base_mod, only : psb_init, psb_ctxt_type implicit none - integer(psb_c_ipk_) :: psb_c_init - - type(psb_ctxt_type) :: ictxt + integer(psb_c_ipk_) :: psb_c_init + type(psb_ctxt_type) :: ctxt - call psb_init(ictxt) - psb_c_init = ictxt%ctxt + call psb_init(ctxt) + psb_c_init = ctxt%ctxt end function psb_c_init - subroutine psb_c_exit_ctxt(ictxt) bind(c) + subroutine psb_c_exit_ctxt(cctxt) bind(c) use psb_base_mod, only : psb_exit, psb_ctxt_type - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) call psb_exit(ctxt,close=.false.) return end subroutine psb_c_exit_ctxt - subroutine psb_c_exit(ictxt) bind(c) + subroutine psb_c_exit(cctxt) bind(c) use psb_base_mod, only : psb_exit, psb_ctxt_type - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) call psb_exit(ctxt) return end subroutine psb_c_exit - subroutine psb_c_abort(ictxt) bind(c) + subroutine psb_c_abort(cctxt) bind(c) use psb_base_mod, only : psb_abort, psb_ctxt_type - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) call psb_abort(ctxt) return end subroutine psb_c_abort - subroutine psb_c_info(ictxt,iam,np) bind(c) + subroutine psb_c_info(cctxt,iam,np) bind(c) use psb_base_mod, only : psb_info, psb_ctxt_type - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt integer(psb_c_ipk_) :: iam,np type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) call psb_info(ctxt,iam,np) return end subroutine psb_c_info - subroutine psb_c_barrier(ictxt) bind(c) + subroutine psb_c_barrier(cctxt) bind(c) use psb_base_mod, only : psb_barrier, psb_ctxt_type - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) call psb_barrier(ctxt) end subroutine psb_c_barrier @@ -100,14 +99,14 @@ contains psb_c_wtime = psb_wtime() end function psb_c_wtime - subroutine psb_c_mbcast(ictxt,n,v,root) bind(c) + subroutine psb_c_mbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root integer(psb_c_mpk_) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -118,14 +117,14 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_mbcast - subroutine psb_c_ibcast(ictxt,n,v,root) bind(c) + subroutine psb_c_ibcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root integer(psb_c_ipk_) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -136,13 +135,13 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_ibcast - subroutine psb_c_lbcast(ictxt,n,v,root) bind(c) + subroutine psb_c_lbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root integer(psb_c_lpk_) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -153,13 +152,13 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_lbcast - subroutine psb_c_ebcast(ictxt,n,v,root) bind(c) + subroutine psb_c_ebcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root integer(psb_c_epk_) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -170,13 +169,13 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_ebcast - subroutine psb_c_sbcast(ictxt,n,v,root) bind(c) + subroutine psb_c_sbcast(cctxt,n,v,root) bind(c) use psb_base_mod implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root real(c_float) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -187,13 +186,13 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_sbcast - subroutine psb_c_dbcast(ictxt,n,v,root) bind(c) + subroutine psb_c_dbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root real(c_double) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -205,13 +204,13 @@ contains end subroutine psb_c_dbcast - subroutine psb_c_cbcast(ictxt,n,v,root) bind(c) + subroutine psb_c_cbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root complex(c_float_complex) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -222,13 +221,13 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_cbcast - subroutine psb_c_zbcast(ictxt,n,v,root) bind(c) + subroutine psb_c_zbcast(cctxt,n,v,root) bind(c) use psb_base_mod implicit none - integer(psb_c_ipk_), value :: ictxt,n, root + integer(psb_c_ipk_), value :: cctxt, n, root complex(c_double_complex) :: v(*) type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -239,14 +238,14 @@ contains call psb_bcast(ctxt,v(1:n),root=root) end subroutine psb_c_zbcast - subroutine psb_c_hbcast(ictxt,v,root) bind(c) + subroutine psb_c_hbcast(cctxt,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: ictxt, root + integer(psb_c_ipk_), value :: cctxt, root character(c_char) :: v(*) integer(psb_ipk_) :: iam, np, n type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) call psb_info(ctxt,iam,np) @@ -291,6 +290,15 @@ contains cmesg(ll) = c_null_char end function psb_c_f2c_errmsg + function psb_c2f_ctxt(cctxt) result(res) + implicit none + integer(psb_ipk_) :: cctxt + type(psb_ctxt_type) :: res + + res%ctxt = cctxt + end function psb_c2f_ctxt + + subroutine psb_c_seterraction_ret() bind(c) use psb_base_mod, only : psb_set_erraction, psb_act_ret_, psb_ctxt_type call psb_set_erraction(psb_act_ret_) diff --git a/cbind/prec/psb_cprec_cbind_mod.f90 b/cbind/prec/psb_cprec_cbind_mod.f90 index 25c545de..3242ac34 100644 --- a/cbind/prec/psb_cprec_cbind_mod.f90 +++ b/cbind/prec/psb_cprec_cbind_mod.f90 @@ -12,14 +12,14 @@ module psb_cprec_cbind_mod contains - - function psb_c_cprecinit(ictxt,ph,ptype) bind(c) result(res) + function psb_c_cprecinit(cctxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod + use psb_cpenv_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_c_cprec) :: ph character(c_char) :: ptype(*) @@ -27,7 +27,7 @@ contains integer(psb_c_ipk_) :: info character(len=80) :: fptype type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/prec/psb_dprec_cbind_mod.f90 b/cbind/prec/psb_dprec_cbind_mod.f90 index b311f890..4845d201 100644 --- a/cbind/prec/psb_dprec_cbind_mod.f90 +++ b/cbind/prec/psb_dprec_cbind_mod.f90 @@ -12,14 +12,14 @@ module psb_dprec_cbind_mod contains - - function psb_c_dprecinit(ictxt,ph,ptype) bind(c) result(res) + function psb_c_dprecinit(cctxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod + use psb_cpenv_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_c_dprec) :: ph character(c_char) :: ptype(*) @@ -27,7 +27,7 @@ contains integer(psb_c_ipk_) :: info character(len=80) :: fptype type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/prec/psb_sprec_cbind_mod.f90 b/cbind/prec/psb_sprec_cbind_mod.f90 index 91854bcd..e95a07a6 100644 --- a/cbind/prec/psb_sprec_cbind_mod.f90 +++ b/cbind/prec/psb_sprec_cbind_mod.f90 @@ -12,14 +12,14 @@ module psb_sprec_cbind_mod contains - - function psb_c_sprecinit(ictxt,ph,ptype) bind(c) result(res) + function psb_c_sprecinit(cctxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod + use psb_cpenv_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_c_sprec) :: ph character(c_char) :: ptype(*) @@ -27,7 +27,7 @@ contains integer(psb_c_ipk_) :: info character(len=80) :: fptype type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/prec/psb_zprec_cbind_mod.f90 b/cbind/prec/psb_zprec_cbind_mod.f90 index 15068ab0..f0c40f40 100644 --- a/cbind/prec/psb_zprec_cbind_mod.f90 +++ b/cbind/prec/psb_zprec_cbind_mod.f90 @@ -12,14 +12,14 @@ module psb_zprec_cbind_mod contains - - function psb_c_zprecinit(ictxt,ph,ptype) bind(c) result(res) + function psb_c_zprecinit(cctxt,ph,ptype) bind(c) result(res) use psb_base_mod use psb_prec_mod + use psb_cpenv_mod use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: ictxt + integer(psb_c_ipk_), value :: cctxt type(psb_c_zprec) :: ph character(c_char) :: ptype(*) @@ -27,7 +27,7 @@ contains integer(psb_c_ipk_) :: info character(len=80) :: fptype type(psb_ctxt_type) :: ctxt - ctxt%ctxt = ictxt + ctxt = psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then From 9178d63ebdb4b5af72e7111f0180506b48cda034 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 18 Nov 2020 15:35:48 +0100 Subject: [PATCH 09/12] Updates for C ctxt handling. --- base/internals/psi_bld_glb_dep_list.F90 | 89 --------------- base/internals/psi_crea_index.f90 | 2 +- base/modules/psi_i_mod.F90 | 14 +-- cbind/base/psb_base_tools_cbind_mod.F90 | 10 +- cbind/base/psb_c_base.c | 21 ++++ cbind/base/psb_c_base.h | 46 ++++---- cbind/base/psb_cpenv_mod.f90 | 137 ++++++++++++++---------- cbind/prec/psb_c_cprec.h | 2 +- cbind/prec/psb_c_dprec.h | 2 +- cbind/prec/psb_c_sprec.h | 2 +- cbind/prec/psb_c_zprec.h | 2 +- cbind/prec/psb_cprec_cbind_mod.f90 | 9 +- cbind/prec/psb_dprec_cbind_mod.f90 | 9 +- cbind/prec/psb_sprec_cbind_mod.f90 | 9 +- cbind/prec/psb_zprec_cbind_mod.f90 | 9 +- cbind/test/pargen/ppdec.c | 68 ++++++------ 16 files changed, 195 insertions(+), 236 deletions(-) diff --git a/base/internals/psi_bld_glb_dep_list.F90 b/base/internals/psi_bld_glb_dep_list.F90 index 4130a0cc..e415ffd2 100644 --- a/base/internals/psi_bld_glb_dep_list.F90 +++ b/base/internals/psi_bld_glb_dep_list.F90 @@ -29,95 +29,6 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -!!$subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,dep_list,dl_lda,info) -!!$ use psi_mod, psb_protect_name => psi_i_bld_glb_dep_list -!!$#ifdef MPI_MOD -!!$ use mpi -!!$#endif -!!$ use psb_penv_mod -!!$ use psb_const_mod -!!$ use psb_error_mod -!!$ use psb_desc_mod -!!$ use psb_sort_mod -!!$ implicit none -!!$#ifdef MPI_H -!!$ include 'mpif.h' -!!$#endif -!!$ ! ....scalar parameters... -!!$ type(psb_ctxt_type), intent(in) :: ctxt -!!$ integer(psb_ipk_), intent(out) :: dl_lda -!!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) -!!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ -!!$ -!!$ ! .....local arrays.... -!!$ integer(psb_ipk_) :: int_err(5) -!!$ -!!$ ! .....local scalars... -!!$ integer(psb_ipk_) :: i, proc,j,err_act -!!$ integer(psb_ipk_) :: err -!!$ integer(psb_ipk_) :: debug_level, debug_unit -!!$ integer(psb_ipk_) :: me, np -!!$ integer(psb_mpk_) :: icomm, minfo -!!$ logical, parameter :: dist_symm_list=.false., print_dl=.false. -!!$ character name*20 -!!$ name='psi_bld_glb_dep_list' -!!$ -!!$ call psb_erractionsave(err_act) -!!$ debug_unit = psb_get_debug_unit() -!!$ debug_level = psb_get_debug_level() -!!$ -!!$ info = psb_success_ -!!$ -!!$ call psb_info(ctxt,me,np) -!!$ -!!$ -!!$ dl_lda = length_dl(me) -!!$ call psb_max(ctxt, dl_lda) -!!$ -!!$ if (debug_level >= psb_debug_inner_) & -!!$ & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda -!!$ dl_lda = max(dl_lda,1) -!!$ allocate(dep_list(dl_lda,0:np),stat=info) -!!$ if (info /= psb_success_) then -!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') -!!$ goto 9999 -!!$ end if -!!$ icomm = psb_get_mpi_comm(ctxt) -!!$ call mpi_allgather(loc_dl,dl_lda,psb_mpi_ipk_,& -!!$ & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo) -!!$ -!!$ info = minfo -!!$ if (info /= psb_success_) then -!!$ info=psb_err_internal_error_ -!!$ goto 9999 -!!$ endif -!!$ if (print_dl) then -!!$ if (me == 0) then -!!$ write(0,*) ' Dep_list ' -!!$ do i=0,np-1 -!!$ j = length_dl(i) -!!$ write(0,*) 'Proc ',i,':',dep_list(1:j,i) -!!$ end do -!!$ flush(0) -!!$ end if -!!$ call psb_barrier(ctxt) -!!$ end if -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$ -!!$9999 continue -!!$ -!!$ call psb_errpush(info,name,i_err=int_err) -!!$ call psb_error_handler(err_act) -!!$ -!!$ return -!!$ -!!$end subroutine psi_i_bld_glb_dep_list - subroutine psi_i_bld_glb_csr_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) use psi_mod, psb_protect_name => psi_i_bld_glb_csr_dep_list #ifdef MPI_MOD diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 334b90f4..a2021e2e 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -126,7 +126,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (choose_sorting(dlmax,dlavg,np)) then if (do_timings) call psb_tic(idx_phase21) - call psi_bld_glb_dep_csr_list(ctxt,& + call psi_bld_glb_dep_list(ctxt,& & loc_dl,length_dl,c_dep_list,dl_ptr,info) if (info /= 0) then write(0,*) me,trim(name),' From bld_glb_list ',info diff --git a/base/modules/psi_i_mod.F90 b/base/modules/psi_i_mod.F90 index bcbc1bb6..31e5d461 100644 --- a/base/modules/psi_i_mod.F90 +++ b/base/modules/psi_i_mod.F90 @@ -110,20 +110,12 @@ module psi_i_mod end interface interface psi_bld_glb_dep_list -!!$ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,dep_list,dl_lda,info) -!!$ import -!!$ type(psb_ctxt_type), intent(in) :: ctxt -!!$ integer(psb_ipk_), intent(out) :: dl_lda -!!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) -!!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:) -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psi_i_bld_glb_dep_list subroutine psi_i_bld_glb_csr_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) import - integer(psb_ipk_), intent(in) :: ctxt - integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) + type(psb_ctxt_type), intent(in) :: ctxt + integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info end subroutine psi_i_bld_glb_csr_dep_list end interface diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index cc69d9d7..f47627d9 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -28,7 +28,7 @@ contains integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: ng - integer(psb_c_ipk_), value :: cctxt + type(psb_c_object_type), value :: cctxt integer(psb_c_ipk_) :: vg(*) type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp @@ -63,7 +63,8 @@ contains implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: nl, cctxt + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: nl integer(psb_c_lpk_) :: vl(*) type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp @@ -103,7 +104,8 @@ contains implicit none integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: nl, cctxt + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: nl type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info @@ -137,7 +139,7 @@ contains integer(psb_c_ipk_) :: res integer(psb_c_lpk_), value :: n - integer(psb_c_ipk_), value :: cctxt + type(psb_c_object_type), value :: cctxt type(psb_c_object_type) :: cdh type(psb_desc_type), pointer :: descp integer(psb_c_ipk_) :: info diff --git a/cbind/base/psb_c_base.c b/cbind/base/psb_c_base.c index 4683e49c..045a1a7c 100644 --- a/cbind/base/psb_c_base.c +++ b/cbind/base/psb_c_base.c @@ -11,6 +11,27 @@ psb_c_descriptor* psb_c_new_descriptor() return(temp); } +void psb_c_delete_descriptor(psb_c_descriptor* cdh) +{ + if (cdh != NULL) free(cdh); + return; +} + +psb_c_ctxt* psb_c_new_ctxt() +{ + psb_c_ctxt* temp; + + temp=(psb_c_ctxt *) malloc(sizeof(psb_c_ctxt)); + temp->ctxt=NULL; + return(temp); +} + +void psb_c_delete_ctxt(psb_c_ctxt* cctxt) +{ + if (cctxt != NULL) free(cctxt); + return; +} + void psb_c_print_errmsg() { diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index 0b7d09e2..bc4eb021 100644 --- a/cbind/base/psb_c_base.h +++ b/cbind/base/psb_c_base.h @@ -43,6 +43,11 @@ extern "C" { } psb_c_descriptor; + typedef struct PSB_C_CTXT { + psb_i_t *ctxt; + } psb_c_ctxt; + + psb_i_t psb_c_error(); psb_i_t psb_c_clean_errstack(); @@ -54,34 +59,37 @@ extern "C" { void psb_c_seterraction_abort(); /* Environment routines */ - psb_i_t psb_c_init(); - void psb_c_exit_ctxt(psb_i_t ictxt); - void psb_c_exit(psb_i_t ictxt); - void psb_c_abort(psb_i_t ictxt); - void psb_c_barrier(psb_i_t ictxt); - void psb_c_info(psb_i_t ictxt, psb_i_t *iam, psb_i_t *np); + void psb_c_init(psb_c_ctxt *cctxt); + void psb_c_exit(psb_c_ctxt cctxt); + void psb_c_exit_ctxt(psb_c_ctxt cctxt); + void psb_c_abort(psb_c_ctxt cctxt); + void psb_c_barrier(psb_c_ctxt cctxt); + void psb_c_info(psb_c_ctxt cctxt, psb_i_t *iam, psb_i_t *np); psb_d_t psb_c_wtime(); psb_i_t psb_c_get_errstatus(); psb_i_t psb_c_get_index_base(); void psb_c_set_index_base(psb_i_t base); - void psb_c_mbcast(psb_i_t ictxt, psb_i_t n, psb_m_t *v, psb_i_t root); - void psb_c_ibcast(psb_i_t ictxt, psb_i_t n, psb_i_t *v, psb_i_t root); - void psb_c_lbcast(psb_i_t ictxt, psb_i_t n, psb_l_t *v, psb_i_t root); - void psb_c_ebcast(psb_i_t ictxt, psb_i_t n, psb_e_t *v, psb_i_t root); - void psb_c_sbcast(psb_i_t ictxt, psb_i_t n, psb_s_t *v, psb_i_t root); - void psb_c_dbcast(psb_i_t ictxt, psb_i_t n, psb_d_t *v, psb_i_t root); - void psb_c_cbcast(psb_i_t ictxt, psb_i_t n, psb_c_t *v, psb_i_t root); - void psb_c_zbcast(psb_i_t ictxt, psb_i_t n, psb_z_t *v, psb_i_t root); - void psb_c_hbcast(psb_i_t ictxt, const char *v, psb_i_t root); + void psb_c_mbcast(psb_c_ctxt cctxt, psb_i_t n, psb_m_t *v, psb_i_t root); + void psb_c_ibcast(psb_c_ctxt cctxt, psb_i_t n, psb_i_t *v, psb_i_t root); + void psb_c_lbcast(psb_c_ctxt cctxt, psb_i_t n, psb_l_t *v, psb_i_t root); + void psb_c_ebcast(psb_c_ctxt cctxt, psb_i_t n, psb_e_t *v, psb_i_t root); + void psb_c_sbcast(psb_c_ctxt cctxt, psb_i_t n, psb_s_t *v, psb_i_t root); + void psb_c_dbcast(psb_c_ctxt cctxt, psb_i_t n, psb_d_t *v, psb_i_t root); + void psb_c_cbcast(psb_c_ctxt cctxt, psb_i_t n, psb_c_t *v, psb_i_t root); + void psb_c_zbcast(psb_c_ctxt cctxt, psb_i_t n, psb_z_t *v, psb_i_t root); + void psb_c_hbcast(psb_c_ctxt cctxt, const char *v, psb_i_t root); /* Descriptor/integer routines */ psb_c_descriptor* psb_c_new_descriptor(); - psb_i_t psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_i_t ictxt, psb_c_descriptor *cd); - psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_i_t ictxt, psb_c_descriptor *cd); - psb_i_t psb_c_cdall_nl(psb_i_t nl, psb_i_t ictxt, psb_c_descriptor *cd); - psb_i_t psb_c_cdall_repl(psb_l_t n, psb_i_t ictxt, psb_c_descriptor *cd); + void psb_c_delete_descriptor(psb_c_descriptor *); + psb_c_ctxt* psb_c_new_ctxt(); + void psb_c_delete_ctxt(psb_c_ctxt *); + psb_i_t psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_c_ctxt cctxt, psb_c_descriptor *cd); + psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_c_ctxt cctxt, psb_c_descriptor *cd); + psb_i_t psb_c_cdall_nl(psb_i_t nl, psb_c_ctxt cctxt, psb_c_descriptor *cd); + psb_i_t psb_c_cdall_repl(psb_l_t n, psb_c_ctxt cctxt, psb_c_descriptor *cd); psb_i_t psb_c_cdasb(psb_c_descriptor *cd); psb_i_t psb_c_cdfree(psb_c_descriptor *cd); psb_i_t psb_c_cdins(psb_i_t nz, const psb_l_t *ia, const psb_l_t *ja, psb_c_descriptor *cd); diff --git a/cbind/base/psb_cpenv_mod.f90 b/cbind/base/psb_cpenv_mod.f90 index ad5bfcfe..a4d588c2 100644 --- a/cbind/base/psb_cpenv_mod.f90 +++ b/cbind/base/psb_cpenv_mod.f90 @@ -30,33 +30,55 @@ contains res = psb_get_errstatus() end function psb_c_get_errstatus - function psb_c_init() bind(c) + subroutine psb_c_init(cctxt) bind(c) use psb_base_mod, only : psb_init, psb_ctxt_type implicit none - integer(psb_c_ipk_) :: psb_c_init - type(psb_ctxt_type) :: ctxt + type(psb_c_object_type) :: cctxt + type(psb_ctxt_type), pointer :: ctxt + integer :: info + if (c_associated(cctxt%item)) then + call c_f_pointer(cctxt%item,ctxt) + deallocate(ctxt,stat=info) + if (info /= 0) return + end if + allocate(ctxt,stat=info) + if (info /= 0) return call psb_init(ctxt) - psb_c_init = ctxt%ctxt - end function psb_c_init + cctxt%item = c_loc(ctxt) + + end subroutine psb_c_init + function psb_c2f_ctxt(cctxt) result(res) + implicit none + type(psb_c_object_type), value :: cctxt + type(psb_ctxt_type), pointer :: res + + !res%ctxt = cctxt%ctxt + if (.not.c_associated(cctxt%item)) then + write(0,*) 'Null item in c2f_ctxt? ' + flush(0) + end if + if (c_associated(cctxt%item)) call c_f_pointer(cctxt%item,res) + end function psb_c2f_ctxt + subroutine psb_c_exit_ctxt(cctxt) bind(c) use psb_base_mod, only : psb_exit, psb_ctxt_type - integer(psb_c_ipk_), value :: cctxt - - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_c_object_type), value :: cctxt + + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) call psb_exit(ctxt,close=.false.) return end subroutine psb_c_exit_ctxt subroutine psb_c_exit(cctxt) bind(c) use psb_base_mod, only : psb_exit, psb_ctxt_type - integer(psb_c_ipk_), value :: cctxt + type(psb_c_object_type), value :: cctxt - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) call psb_exit(ctxt) return @@ -64,10 +86,10 @@ contains subroutine psb_c_abort(cctxt) bind(c) use psb_base_mod, only : psb_abort, psb_ctxt_type - integer(psb_c_ipk_), value :: cctxt + type(psb_c_object_type), value :: cctxt - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) call psb_abort(ctxt) return end subroutine psb_c_abort @@ -75,21 +97,21 @@ contains subroutine psb_c_info(cctxt,iam,np) bind(c) use psb_base_mod, only : psb_info, psb_ctxt_type - integer(psb_c_ipk_), value :: cctxt + type(psb_c_object_type), value :: cctxt integer(psb_c_ipk_) :: iam,np - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) call psb_info(ctxt,iam,np) return end subroutine psb_c_info subroutine psb_c_barrier(cctxt) bind(c) use psb_base_mod, only : psb_barrier, psb_ctxt_type - integer(psb_c_ipk_), value :: cctxt + type(psb_c_object_type), value :: cctxt - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) call psb_barrier(ctxt) end subroutine psb_c_barrier @@ -102,11 +124,12 @@ contains subroutine psb_c_mbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root integer(psb_c_mpk_) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -120,11 +143,12 @@ contains subroutine psb_c_ibcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root integer(psb_c_ipk_) :: v(*) - type(psb_ctxt_type) :: ctxt + type(psb_ctxt_type), pointer :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -138,10 +162,11 @@ contains subroutine psb_c_lbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root integer(psb_c_lpk_) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -155,10 +180,11 @@ contains subroutine psb_c_ebcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root integer(psb_c_epk_) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -172,10 +198,11 @@ contains subroutine psb_c_sbcast(cctxt,n,v,root) bind(c) use psb_base_mod implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root real(c_float) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -189,10 +216,11 @@ contains subroutine psb_c_dbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root real(c_double) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -207,10 +235,11 @@ contains subroutine psb_c_cbcast(cctxt,n,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root complex(c_float_complex) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -224,10 +253,11 @@ contains subroutine psb_c_zbcast(cctxt,n,v,root) bind(c) use psb_base_mod implicit none - integer(psb_c_ipk_), value :: cctxt, n, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: n, root complex(c_double_complex) :: v(*) - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) if (n < 0) then write(0,*) 'Wrong size in BCAST' @@ -241,11 +271,12 @@ contains subroutine psb_c_hbcast(cctxt,v,root) bind(c) use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_, psb_ctxt_type implicit none - integer(psb_c_ipk_), value :: cctxt, root + type(psb_c_object_type), value :: cctxt + integer(psb_c_ipk_), value :: root character(c_char) :: v(*) integer(psb_ipk_) :: iam, np, n - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + ctxt => psb_c2f_ctxt(cctxt) call psb_info(ctxt,iam,np) @@ -289,15 +320,6 @@ contains end if cmesg(ll) = c_null_char end function psb_c_f2c_errmsg - - function psb_c2f_ctxt(cctxt) result(res) - implicit none - integer(psb_ipk_) :: cctxt - type(psb_ctxt_type) :: res - - res%ctxt = cctxt - end function psb_c2f_ctxt - subroutine psb_c_seterraction_ret() bind(c) use psb_base_mod, only : psb_set_erraction, psb_act_ret_, psb_ctxt_type @@ -313,6 +335,5 @@ contains use psb_base_mod, only : psb_set_erraction, psb_act_abort_, psb_ctxt_type call psb_set_erraction(psb_act_abort_) end subroutine psb_c_seterraction_abort - end module psb_cpenv_mod diff --git a/cbind/prec/psb_c_cprec.h b/cbind/prec/psb_c_cprec.h index 452f1c03..60c2ef87 100644 --- a/cbind/prec/psb_c_cprec.h +++ b/cbind/prec/psb_c_cprec.h @@ -14,7 +14,7 @@ extern "C" { psb_c_cprec* psb_c_new_cprec(); - psb_i_t psb_c_cprecinit(psb_i_t ictxt,psb_c_cprec *ph, const char *ptype); + psb_i_t psb_c_cprecinit(psb_c_ctxt cctxt,psb_c_cprec *ph, const char *ptype); psb_i_t psb_c_cprecbld(psb_c_cspmat *ah, psb_c_descriptor *cdh, psb_c_cprec *ph); psb_i_t psb_c_cprecfree(psb_c_cprec *ph); #ifdef __cplusplus diff --git a/cbind/prec/psb_c_dprec.h b/cbind/prec/psb_c_dprec.h index 90ab72e6..3e3c9438 100644 --- a/cbind/prec/psb_c_dprec.h +++ b/cbind/prec/psb_c_dprec.h @@ -14,7 +14,7 @@ extern "C" { psb_c_dprec* psb_c_new_dprec(); - psb_i_t psb_c_dprecinit(psb_i_t ictxt, psb_c_dprec *ph, const char *ptype); + psb_i_t psb_c_dprecinit(psb_c_ctxt cctxt, psb_c_dprec *ph, const char *ptype); psb_i_t psb_c_dprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, psb_c_dprec *ph); psb_i_t psb_c_dprecfree(psb_c_dprec *ph); #ifdef __cplusplus diff --git a/cbind/prec/psb_c_sprec.h b/cbind/prec/psb_c_sprec.h index 57d66c01..8f6ab0c4 100644 --- a/cbind/prec/psb_c_sprec.h +++ b/cbind/prec/psb_c_sprec.h @@ -14,7 +14,7 @@ extern "C" { psb_c_sprec* psb_c_new_sprec(); - psb_i_t psb_c_sprecinit(psb_i_t ictxt, psb_c_sprec *ph, const char *ptype); + psb_i_t psb_c_sprecinit(psb_c_ctxt cctxt, psb_c_sprec *ph, const char *ptype); psb_i_t psb_c_sprecbld(psb_c_sspmat *ah, psb_c_descriptor *cdh, psb_c_sprec *ph); psb_i_t psb_c_sprecfree(psb_c_sprec *ph); #ifdef __cplusplus diff --git a/cbind/prec/psb_c_zprec.h b/cbind/prec/psb_c_zprec.h index f86e3844..40327f39 100644 --- a/cbind/prec/psb_c_zprec.h +++ b/cbind/prec/psb_c_zprec.h @@ -14,7 +14,7 @@ extern "C" { psb_c_zprec* psb_c_new_zprec(); - psb_i_t psb_c_zprecinit(psb_i_t ictxt, psb_c_zprec *ph, const char *ptype); + psb_i_t psb_c_zprecinit(psb_c_ctxt cctxt, psb_c_zprec *ph, const char *ptype); psb_i_t psb_c_zprecbld(psb_c_zspmat *ah, psb_c_descriptor *cdh, psb_c_zprec *ph); psb_i_t psb_c_zprecfree(psb_c_zprec *ph); #ifdef __cplusplus diff --git a/cbind/prec/psb_cprec_cbind_mod.f90 b/cbind/prec/psb_cprec_cbind_mod.f90 index 3242ac34..a901b830 100644 --- a/cbind/prec/psb_cprec_cbind_mod.f90 +++ b/cbind/prec/psb_cprec_cbind_mod.f90 @@ -18,16 +18,17 @@ contains use psb_cpenv_mod use psb_base_string_cbind_mod implicit none - integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: cctxt + integer(psb_c_ipk_) :: res + type(psb_c_object_type), value :: cctxt type(psb_c_cprec) :: ph character(c_char) :: ptype(*) type(psb_cprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + + ctxt => psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/prec/psb_dprec_cbind_mod.f90 b/cbind/prec/psb_dprec_cbind_mod.f90 index 4845d201..7f321a17 100644 --- a/cbind/prec/psb_dprec_cbind_mod.f90 +++ b/cbind/prec/psb_dprec_cbind_mod.f90 @@ -18,16 +18,17 @@ contains use psb_cpenv_mod use psb_base_string_cbind_mod implicit none - integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: cctxt + integer(psb_c_ipk_) :: res + type(psb_c_object_type), value :: cctxt type(psb_c_dprec) :: ph character(c_char) :: ptype(*) type(psb_dprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + + ctxt => psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/prec/psb_sprec_cbind_mod.f90 b/cbind/prec/psb_sprec_cbind_mod.f90 index e95a07a6..3ce66f52 100644 --- a/cbind/prec/psb_sprec_cbind_mod.f90 +++ b/cbind/prec/psb_sprec_cbind_mod.f90 @@ -18,16 +18,17 @@ contains use psb_cpenv_mod use psb_base_string_cbind_mod implicit none - integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: cctxt + integer(psb_c_ipk_) :: res + type(psb_c_object_type), value :: cctxt type(psb_c_sprec) :: ph character(c_char) :: ptype(*) type(psb_sprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + + ctxt => psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/prec/psb_zprec_cbind_mod.f90 b/cbind/prec/psb_zprec_cbind_mod.f90 index f0c40f40..5ca76df1 100644 --- a/cbind/prec/psb_zprec_cbind_mod.f90 +++ b/cbind/prec/psb_zprec_cbind_mod.f90 @@ -18,16 +18,17 @@ contains use psb_cpenv_mod use psb_base_string_cbind_mod implicit none - integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: cctxt + integer(psb_c_ipk_) :: res + type(psb_c_object_type), value :: cctxt type(psb_c_zprec) :: ph character(c_char) :: ptype(*) type(psb_zprec_type), pointer :: precp integer(psb_c_ipk_) :: info character(len=80) :: fptype - type(psb_ctxt_type) :: ctxt - ctxt = psb_c2f_ctxt(cctxt) + type(psb_ctxt_type), pointer :: ctxt + + ctxt => psb_c2f_ctxt(cctxt) res = -1 if (c_associated(ph%item)) then diff --git a/cbind/test/pargen/ppdec.c b/cbind/test/pargen/ppdec.c index eb0ecff5..0671ec9e 100644 --- a/cbind/test/pargen/ppdec.c +++ b/cbind/test/pargen/ppdec.c @@ -120,7 +120,7 @@ double g(double x, double y, double z) } } -psb_i_t matgen(psb_i_t ictxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[], +psb_i_t matgen(psb_c_ctxt cctxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[], psb_c_dspmat *ah,psb_c_descriptor *cdh, psb_c_dvector *xh, psb_c_dvector *bh, psb_c_dvector *rh) { @@ -132,7 +132,7 @@ psb_i_t matgen(psb_i_t ictxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[], psb_l_t irow[10*NBMAX], icol[10*NBMAX]; info = 0; - psb_c_info(ictxt,&iam,&np); + psb_c_info(cctxt,&iam,&np); deltah = (double) 1.0/(idim+1); sqdeltah = deltah*deltah; deltah2 = 2.0* deltah; @@ -223,7 +223,8 @@ psb_i_t matgen(psb_i_t ictxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[], int main(int argc, char *argv[]) { - psb_i_t ictxt, iam, np; + psb_c_ctxt *cctxt; + psb_i_t iam, np; char methd[40], ptype[20], afmt[8], buffer[LINEBUFSIZE+1]; psb_i_t nparms; psb_i_t idim,info,istop,itmax,itrace,irst,iter,ret; @@ -238,13 +239,12 @@ int main(int argc, char *argv[]) psb_c_SolverOptions options; psb_c_descriptor *cdh; FILE *vectfile; - - ictxt = psb_c_init(); - psb_c_info(ictxt,&iam,&np); - fprintf(stdout,"Initialization: am %d of %d\n",iam,np); - fflush(stdout); - psb_c_barrier(ictxt); + cctxt = psb_c_new_ctxt(); + psb_c_init(cctxt); + psb_c_info(*cctxt,&iam,&np); + + psb_c_barrier(*cctxt); if (iam == 0) { fgets(buffer,LINEBUFSIZE,stdin); sscanf(buffer,"%d ",&nparms); @@ -264,22 +264,22 @@ int main(int argc, char *argv[]) sscanf(buffer,"%d",&itrace); fgets(buffer,LINEBUFSIZE,stdin); sscanf(buffer,"%d",&irst); - } + } /* Now broadcast the values, and check they're OK */ - psb_c_ibcast(ictxt,1,&nparms,0); - psb_c_hbcast(ictxt,methd,0); - psb_c_hbcast(ictxt,ptype,0); - psb_c_hbcast(ictxt,afmt,0); - psb_c_ibcast(ictxt,1,&idim,0); - psb_c_ibcast(ictxt,1,&istop,0); - psb_c_ibcast(ictxt,1,&itmax,0); - psb_c_ibcast(ictxt,1,&itrace,0); - psb_c_ibcast(ictxt,1,&irst,0); + psb_c_ibcast(*cctxt,1,&nparms,0); + psb_c_hbcast(*cctxt,methd,0); + psb_c_hbcast(*cctxt,ptype,0); + psb_c_hbcast(*cctxt,afmt,0); + psb_c_ibcast(*cctxt,1,&idim,0); + psb_c_ibcast(*cctxt,1,&istop,0); + psb_c_ibcast(*cctxt,1,&itmax,0); + psb_c_ibcast(*cctxt,1,&itrace,0); + psb_c_ibcast(*cctxt,1,&irst,0); fprintf(stderr,"%d Check on received: methd %s ptype %s afmt %s\n", iam,methd,ptype,afmt); fflush(stderr); - psb_c_barrier(ictxt); + psb_c_barrier(*cctxt); cdh=psb_c_new_descriptor(); psb_c_set_index_base(0); @@ -292,15 +292,15 @@ int main(int argc, char *argv[]) fprintf(stderr,"%d: Input data %d %ld %d %d\n",iam,idim,ng,nb, nl); if ((vl=malloc(nb*sizeof(psb_l_t)))==NULL) { fprintf(stderr,"On %d: malloc failure\n",iam); - psb_c_abort(ictxt); + psb_c_abort(*cctxt); } i = ((psb_l_t)iam) * nb; for (k=0; kdescriptor); @@ -412,8 +412,8 @@ int main(int argc, char *argv[]) free(cdh); - if (iam == 0) fprintf(stderr,"program completed successfully\n"); + //if (iam == 0) fprintf(stderr,"program completed successfully\n"); - psb_c_barrier(ictxt); - psb_c_exit(ictxt); + psb_c_barrier(*cctxt); + psb_c_exit(*cctxt); } From e1d859e3f52c48fba2d5f3e0e9b4952b308a44b8 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 18 Nov 2020 16:47:23 +0100 Subject: [PATCH 10/12] Change return value of get_context on error. --- base/modules/desc/psb_desc_mod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index cc003759..c1c98d51 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -613,8 +613,10 @@ contains if (allocated(desc%indxmap)) then val = desc%indxmap%get_ctxt() else - call psb_errpush(psb_err_invalid_cd_state_,'psb_cd_get_context') - call psb_error() + ! At this point, val should a non-ALLOCATED + ! ctxt component, which suits us just fine. + !call psb_errpush(psb_err_invalid_cd_state_,'psb_cd_get_context') + !call psb_error() end if end function psb_cd_get_context From b32053d8aa16ceb12ab16d1ae8e08810f01fa32a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 19 Nov 2020 16:02:24 +0100 Subject: [PATCH 11/12] Fix base_init_null for use with remap-coarse --- base/modules/desc/psb_indx_map_mod.f90 | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index d18458f0..9e693ec3 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -224,6 +224,7 @@ module psb_indx_map_mod generic, public :: qry_halo_owner => qry_halo_owner_s, qry_halo_owner_v procedure, pass(idxmap) :: fnd_owner => psi_indx_map_fnd_owner + procedure, pass(idxmap) :: init_null => base_init_null procedure, pass(idxmap) :: init_vl => base_init_vl generic, public :: init => init_vl @@ -242,7 +243,7 @@ module psb_indx_map_mod & base_ll2gs1, base_ll2gs2, base_ll2gv1, base_ll2gv2,& & base_lg2ls1, base_lg2ls2, base_lg2lv1, base_lg2lv2,& & base_lg2ls1_ins, base_lg2ls2_ins, base_lg2lv1_ins,& - & base_lg2lv2_ins, base_init_vl, base_is_null,& + & base_lg2lv2_ins, base_init_vl, base_is_null, base_init_null, & & base_row_extendable, base_clone, base_cpy, base_reinit, & & base_set_halo_owner, base_get_halo_owner, & & base_qry_halo_owner_s, base_qry_halo_owner_v,& @@ -1345,6 +1346,18 @@ contains end subroutine base_set_null + subroutine base_init_null(idxmap,ctxt,info) + class(psb_indx_map), intent(inout) :: idxmap + type(psb_ctxt_type), intent(in) :: ctxt + integer(psb_lpk_), intent(in) :: vl(:) + integer(psb_ipk_), intent(out) :: info + + call idxmap%set_null() + idxmap%ctxt = ctxt + info = 0 + return + end subroutine base_init_null + subroutine base_init_vl(idxmap,ctxt,vl,info) use psb_penv_mod use psb_error_mod @@ -1414,7 +1427,7 @@ contains call psb_get_erraction(err_act) outmap%state = idxmap%state - outmap%ctxt = idxmap%ctxt + outmap%ctxt = idxmap%ctxt outmap%mpic = idxmap%mpic outmap%global_rows = idxmap%global_rows outmap%global_cols = idxmap%global_cols From bab24cec2756c9b02f6d2dcaa4c8bc33b40d4382 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 20 Nov 2020 08:26:34 +0100 Subject: [PATCH 12/12] Fix indx_map compilation --- base/modules/desc/psb_indx_map_mod.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index 9e693ec3..0c0d8199 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -1349,7 +1349,6 @@ contains subroutine base_init_null(idxmap,ctxt,info) class(psb_indx_map), intent(inout) :: idxmap type(psb_ctxt_type), intent(in) :: ctxt - integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info call idxmap%set_null()