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

Merge branch 'development' into cmake

Browse Source
newmatdist
Luca Pepè Sciarria 1 year ago
parent b5ac51a262 52cec1761c
commit e4ba4554d1
345 changed files with 3350 additions and 3093 deletions
Show Stats Download Patch File Download Diff File

1
.gitignore vendored
Unescape Escape View File

@ -7,6 +7,7 @@
# header files generated
/cbind/*.h
/util/psb_metis_int.h
/base/modules/psb_config.h
# Make.inc generated
/Make.inc

4
Make.inc.in
Unescape Escape View File

@ -83,8 +83,8 @@ SPGPU_LIBS=@SPGPU_LIBS@
CUDA_DIR=@CUDA_DIR@
CUDA_INCLUDES=@CUDA_INCLUDES@
CUDA_LIBS=@CUDA_LIBS@
CUDA_VERSION=@CUDA_VERSION@
CUDA_SHORT_VERSION=@CUDA_SHORT_VERSION@
PSB_CUDA_VERSION=@PSB_CUDA_VERSION@
PSB_CUDA_SHORT_VERSION=@PSB_CUDA_SHORT_VERSION@
CUDA_DEFINES=@CUDA_DEFINES@
FCUDEFINES=@FCUDEFINES@
CCUDEFINES=@CCUDEFINES@

15
Makefile
Unescape Escape View File

@ -40,11 +40,11 @@ utild:
$(MAKE) -C util objs
cbindd:
$(MAKE) -C cbind objs
extd: based
extd:
$(MAKE) -C ext objs
cudad: based extd
cudad:
$(MAKE) -C cuda objs
oaccd: based extd
oaccd:
$(MAKE) -C openacc objs
@ -62,8 +62,8 @@ install: all
mkdir -p $(INSTALL_DOCSDIR) && \
$(INSTALL_DATA) README.md LICENSE $(INSTALL_DOCSDIR)
mkdir -p $(INSTALL_SAMPLESDIR) && \
/bin/cp -fr test/pargen test/fileread $(INSTALL_SAMPLESDIR) && \
mkdir -p $(INSTALL_SAMPLESDIR)/cbind && /bin/cp -fr cbind/test/pargen/* $(INSTALL_SAMPLESDIR)/cbind
/bin/cp -fr test/pdegen test/fileread $(INSTALL_SAMPLESDIR) && \
mkdir -p $(INSTALL_SAMPLESDIR)/cbind && /bin/cp -fr cbind/test/pdegen/* $(INSTALL_SAMPLESDIR)/cbind
clean: cleanlib
$(MAKE) -C base veryclean
$(MAKE) -C prec veryclean
@ -75,7 +75,7 @@ clean: cleanlib
$(MAKE) -C openacc veryclean
cleantest:
cd test/fileread && $(MAKE) clean
cd test/pargen && $(MAKE) clean
cd test/pdegen && $(MAKE) clean
cd test/util && $(MAKE) clean
cleanlib:
@ -84,8 +84,7 @@ cleanlib:
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh) *.h)
distclean: clean
/bin/rm -f Make.inc util/psb_metis_int.h base/modules/psb_config.h \
base/modules/psb_cxxconfig.h
/bin/rm -f Make.inc util/psb_metis_int.h base/modules/psb_config.h
check: all
make check -C test/serial

16
base/comm/internals/psi_cswapdata.F90
Unescape Escape View File

@ -96,11 +96,11 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -184,11 +184,11 @@ subroutine psi_cswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_c_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -434,11 +434,11 @@ subroutine psi_cswapdata_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -522,11 +522,11 @@ subroutine psi_cswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_c_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_cswapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_cswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_cswapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_cswaptran.F90
Unescape Escape View File

@ -98,11 +98,11 @@ subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -185,11 +185,11 @@ subroutine psi_ctran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_c_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -445,11 +445,11 @@ subroutine psi_cswaptran_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -533,11 +533,11 @@ subroutine psi_ctran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_c_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_cswaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_ctranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_ctranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

@ -96,11 +96,11 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -184,11 +184,11 @@ subroutine psi_dswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_d_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -434,11 +434,11 @@ subroutine psi_dswapdata_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -522,11 +522,11 @@ subroutine psi_dswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_d_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_dswapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_dswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_dswapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_dswaptran.F90
Unescape Escape View File

@ -98,11 +98,11 @@ subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -185,11 +185,11 @@ subroutine psi_dtran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_d_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -445,11 +445,11 @@ subroutine psi_dswaptran_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -533,11 +533,11 @@ subroutine psi_dtran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_d_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_dswaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_dtranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_dtranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_eswapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_eswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_eswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_eswapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_eswapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_eswaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_eswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_etranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_eswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_etranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_i2swapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_i2swapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_i2swapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_i2swapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_i2swapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_i2swaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_i2swaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_i2tranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_i2swaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_i2tranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_iswapdata.F90
Unescape Escape View File

@ -96,11 +96,11 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -184,11 +184,11 @@ subroutine psi_iswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_i_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -434,11 +434,11 @@ subroutine psi_iswapdata_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -522,11 +522,11 @@ subroutine psi_iswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_i_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_iswaptran.F90
Unescape Escape View File

@ -98,11 +98,11 @@ subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -185,11 +185,11 @@ subroutine psi_itran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_i_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -445,11 +445,11 @@ subroutine psi_iswaptran_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -533,11 +533,11 @@ subroutine psi_itran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_i_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_lswapdata.F90
Unescape Escape View File

@ -96,11 +96,11 @@ subroutine psi_lswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -184,11 +184,11 @@ subroutine psi_lswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_l_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -434,11 +434,11 @@ subroutine psi_lswapdata_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -522,11 +522,11 @@ subroutine psi_lswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_l_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_lswaptran.F90
Unescape Escape View File

@ -98,11 +98,11 @@ subroutine psi_lswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -185,11 +185,11 @@ subroutine psi_ltran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_l_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -445,11 +445,11 @@ subroutine psi_lswaptran_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -533,11 +533,11 @@ subroutine psi_ltran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_l_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_mswapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_mswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_mswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_mswapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_mswapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_mswaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_mswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_mtranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_mswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_mtranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_sswapdata.F90
Unescape Escape View File

@ -96,11 +96,11 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -184,11 +184,11 @@ subroutine psi_sswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_s_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -434,11 +434,11 @@ subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -522,11 +522,11 @@ subroutine psi_sswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_s_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_sswapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_sswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_sswapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_sswaptran.F90
Unescape Escape View File

@ -98,11 +98,11 @@ subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -185,11 +185,11 @@ subroutine psi_stran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_s_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -445,11 +445,11 @@ subroutine psi_sswaptran_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -533,11 +533,11 @@ subroutine psi_stran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_s_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_sswaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_stranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_stranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_zswapdata.F90
Unescape Escape View File

@ -96,11 +96,11 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -184,11 +184,11 @@ subroutine psi_zswap_vidx_vect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_z_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -434,11 +434,11 @@ subroutine psi_zswapdata_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -522,11 +522,11 @@ subroutine psi_zswap_vidx_multivect(ctxt,icomm,flag,beta,y,idx, &
use psb_desc_mod
use psb_penv_mod
use psb_z_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_zswapdata_a.F90
Unescape Escape View File

@ -90,11 +90,11 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -161,11 +161,11 @@ subroutine psi_zswapidxm(ctxt,icomm,flag,n,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -567,11 +567,11 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -649,11 +649,11 @@ subroutine psi_zswapidxv(ctxt,icomm,flag,beta,y,idx, &
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_zswaptran.F90
Unescape Escape View File

@ -98,11 +98,11 @@ subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -185,11 +185,11 @@ subroutine psi_ztran_vidx_vect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_z_base_vect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -445,11 +445,11 @@ subroutine psi_zswaptran_multivect(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -533,11 +533,11 @@ subroutine psi_ztran_vidx_multivect(ctxt,icomm,flag,beta,y,idx,&
use psb_desc_mod
use psb_penv_mod
use psb_z_base_multivect_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/internals/psi_zswaptran_a.F90
Unescape Escape View File

@ -94,11 +94,11 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -166,11 +166,11 @@ subroutine psi_ztranidxm(ctxt,icomm,flag,n,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -579,11 +579,11 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -661,11 +661,11 @@ subroutine psi_ztranidxv(ctxt,icomm,flag,beta,y,idx,&
use psb_error_mod
use psb_desc_mod
use psb_penv_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

16
base/comm/psb_cscatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_cscatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_cscatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_cscatterm
!
subroutine psb_cscatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_cscatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -33,8 +33,8 @@
!
! Gathers a sparse matrix onto a single process.
! Two variants:
! 1. Gathers to PSB_c_SPARSE_MAT (i.e. to matrix with IPK_ indices)
! 2. Gathers to PSB_lc_SPARSE_MAT (i.e. to matrix with LPK_ indices)
! 1. Gathers to PSB_c_SPARSE_MAT (i.e. to matrix with PSB_IPK_ indices)
! 2. Gathers to PSB_lc_SPARSE_MAT (i.e. to matrix with PSB_LPK_ indices)
!
! Note: this function uses MPI_ALLGATHERV. At this time, the size of the
! resulting matrix must be within the range of 4 bytes because of the
@ -49,11 +49,11 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_cspmat_type), intent(inout) :: loca
@ -233,11 +233,11 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_cspmat_type), intent(inout) :: loca
@ -406,11 +406,11 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_lcspmat_type), intent(inout) :: loca

16
base/comm/psb_dscatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_dscatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_dscatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_dscatterm
!
subroutine psb_dscatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_dscatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -33,8 +33,8 @@
!
! Gathers a sparse matrix onto a single process.
! Two variants:
! 1. Gathers to PSB_d_SPARSE_MAT (i.e. to matrix with IPK_ indices)
! 2. Gathers to PSB_ld_SPARSE_MAT (i.e. to matrix with LPK_ indices)
! 1. Gathers to PSB_d_SPARSE_MAT (i.e. to matrix with PSB_IPK_ indices)
! 2. Gathers to PSB_ld_SPARSE_MAT (i.e. to matrix with PSB_LPK_ indices)
!
! Note: this function uses MPI_ALLGATHERV. At this time, the size of the
! resulting matrix must be within the range of 4 bytes because of the
@ -49,11 +49,11 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_dspmat_type), intent(inout) :: loca
@ -233,11 +233,11 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_dspmat_type), intent(inout) :: loca
@ -406,11 +406,11 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ldspmat_type), intent(inout) :: loca

16
base/comm/psb_escatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_escatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_escatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_escatterm
!
subroutine psb_escatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_escatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_i2scatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_i2scatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_i2scatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_i2scatterm
!
subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_i2scatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_i2scatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_ispgather.F90
Unescape Escape View File

@ -33,8 +33,8 @@
!
! Gathers a sparse matrix onto a single process.
! Two variants:
! 1. Gathers to PSB_i_SPARSE_MAT (i.e. to matrix with IPK_ indices)
! 2. Gathers to PSB_@LX@_SPARSE_MAT (i.e. to matrix with LPK_ indices)
! 1. Gathers to PSB_i_SPARSE_MAT (i.e. to matrix with PSB_IPK_ indices)
! 2. Gathers to PSB_@LX@_SPARSE_MAT (i.e. to matrix with PSB_LPK_ indices)
!
! Note: this function uses MPI_ALLGATHERV. At this time, the size of the
! resulting matrix must be within the range of 4 bytes because of the
@ -49,11 +49,11 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ispmat_type), intent(inout) :: loca
@ -233,11 +233,11 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ispmat_type), intent(inout) :: loca
@ -406,11 +406,11 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_@LX@spmat_type), intent(inout) :: loca

16
base/comm/psb_lspgather.F90
Unescape Escape View File

@ -33,8 +33,8 @@
!
! Gathers a sparse matrix onto a single process.
! Two variants:
! 1. Gathers to PSB_l_SPARSE_MAT (i.e. to matrix with IPK_ indices)
! 2. Gathers to PSB_@LX@_SPARSE_MAT (i.e. to matrix with LPK_ indices)
! 1. Gathers to PSB_l_SPARSE_MAT (i.e. to matrix with PSB_IPK_ indices)
! 2. Gathers to PSB_@LX@_SPARSE_MAT (i.e. to matrix with PSB_LPK_ indices)
!
! Note: this function uses MPI_ALLGATHERV. At this time, the size of the
! resulting matrix must be within the range of 4 bytes because of the
@ -49,11 +49,11 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_lspmat_type), intent(inout) :: loca
@ -233,11 +233,11 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_lspmat_type), intent(inout) :: loca
@ -406,11 +406,11 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_@LX@spmat_type), intent(inout) :: loca

16
base/comm/psb_mscatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_mscatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_mscatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_mscatterm
!
subroutine psb_mscatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_mscatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_sscatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_sscatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_sscatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_sscatterm
!
subroutine psb_sscatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_sscatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_sspgather.F90
Unescape Escape View File

@ -33,8 +33,8 @@
!
! Gathers a sparse matrix onto a single process.
! Two variants:
! 1. Gathers to PSB_s_SPARSE_MAT (i.e. to matrix with IPK_ indices)
! 2. Gathers to PSB_ls_SPARSE_MAT (i.e. to matrix with LPK_ indices)
! 1. Gathers to PSB_s_SPARSE_MAT (i.e. to matrix with PSB_IPK_ indices)
! 2. Gathers to PSB_ls_SPARSE_MAT (i.e. to matrix with PSB_LPK_ indices)
!
! Note: this function uses MPI_ALLGATHERV. At this time, the size of the
! resulting matrix must be within the range of 4 bytes because of the
@ -49,11 +49,11 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_sspmat_type), intent(inout) :: loca
@ -233,11 +233,11 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_sspmat_type), intent(inout) :: loca
@ -406,11 +406,11 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_lsspmat_type), intent(inout) :: loca

16
base/comm/psb_zscatter_a.F90
Unescape Escape View File

@ -46,11 +46,11 @@
subroutine psb_zscatterm(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_zscatterm
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -162,8 +162,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&
@ -291,11 +291,11 @@ end subroutine psb_zscatterm
!
subroutine psb_zscatterv(globx, locx, desc_a, info, root)
use psb_base_mod, psb_protect_name => psb_zscatterv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -398,8 +398,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
else
rootrank = psb_get_mpi_rank(ctxt,iroot)
!
! This is potentially unsafe when IPK=8
! But then, IPK=8 is highly experimental anyway.
! This is potentially unsafe when PSB_IPK=8
! But then, PSB_IPK=8 is highly experimental anyway.
!
nlr = nrow
call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,&

16
base/comm/psb_zspgather.F90
Unescape Escape View File

@ -33,8 +33,8 @@
!
! Gathers a sparse matrix onto a single process.
! Two variants:
! 1. Gathers to PSB_z_SPARSE_MAT (i.e. to matrix with IPK_ indices)
! 2. Gathers to PSB_lz_SPARSE_MAT (i.e. to matrix with LPK_ indices)
! 1. Gathers to PSB_z_SPARSE_MAT (i.e. to matrix with PSB_IPK_ indices)
! 2. Gathers to PSB_lz_SPARSE_MAT (i.e. to matrix with PSB_LPK_ indices)
!
! Note: this function uses MPI_ALLGATHERV. At this time, the size of the
! resulting matrix must be within the range of 4 bytes because of the
@ -49,11 +49,11 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_zspmat_type), intent(inout) :: loca
@ -233,11 +233,11 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_zspmat_type), intent(inout) :: loca
@ -406,11 +406,11 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
use psb_mat_mod
use psb_tools_mod
use iso_c_binding
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_lzspmat_type), intent(inout) :: loca

6
base/internals/psi_a2a_fnd_owner.F90
Unescape Escape View File

@ -55,12 +55,12 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize)
use psb_penv_mod
use psb_realloc_mod
use psb_indx_map_mod, psb_protect_name => psi_a2a_fnd_owner
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
@ -138,7 +138,7 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize)
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
goto 9999
end if
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
iprc(:) = 0
#else
call mpi_allgather(idx,nv,psb_mpi_lpk_,rmtidx,nv,psb_mpi_lpk_,icomm,minfo)

6
base/internals/psi_adjcncy_fnd_owner.F90
Unescape Escape View File

@ -61,12 +61,12 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
use psb_realloc_mod
use psb_timers_mod
use psb_indx_map_mod, psb_protect_name => psi_adjcncy_fnd_owner
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
@ -139,7 +139,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_realloc')
goto 9999
end if
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
iprc(:) = 0
#else
iprc = -1

4
base/internals/psi_bld_glb_dep_list.F90
Unescape Escape View File

@ -31,7 +31,7 @@
!
subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
use psi_mod, psb_protect_name => psi_i_bld_glb_dep_list
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
use psb_penv_mod
@ -40,7 +40,7 @@ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
use psb_desc_mod
use psb_sort_mod
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
! ....scalar parameters...

4
base/internals/psi_desc_index.F90
Unescape Escape View File

@ -101,14 +101,14 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
use psb_realloc_mod
use psb_error_mod
use psb_const_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
use psb_penv_mod
use psb_timers_mod
use psi_mod, psb_protect_name => psi_i_desc_index
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif

4
base/internals/psi_fnd_owner.F90
Unescape Escape View File

@ -54,12 +54,12 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
use psb_penv_mod
use psb_realloc_mod
use psi_mod, psb_protect_name => psi_fnd_owner
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_ipk_), intent(in) :: nv

8
base/internals/psi_graph_fnd_owner.F90
Unescape Escape View File

@ -86,12 +86,12 @@ subroutine psi_graph_fnd_owner(idx,iprc,ladj,idxmap,info)
use psb_realloc_mod
use psb_timers_mod
use psb_desc_mod, psb_protect_name => psi_graph_fnd_owner
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)
@ -152,7 +152,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,ladj,idxmap,info)
!
nv = size(idx)
call psb_realloc(nv,iprc,info)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
iprc(:) = 0
#else
if (info == psb_success_) call psb_realloc(nv,tidx,info)
@ -291,7 +291,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,ladj,idxmap,info)
9999 call psb_error_handler(ctxt,err_act)
return
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
contains

4
base/internals/psi_indx_map_fnd_owner.F90
Unescape Escape View File

@ -58,12 +58,12 @@ subroutine psi_indx_map_fnd_owner(idx,iprc,idxmap,info,adj)
use psb_penv_mod
use psb_realloc_mod
use psb_indx_map_mod, psb_protect_name => psi_indx_map_fnd_owner
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_), intent(in) :: idx(:)

8
base/internals/psi_symm_dep_list.F90
Unescape Escape View File

@ -44,12 +44,12 @@ subroutine psi_symm_dep_list_inrv(rvsz,adj,ctxt,info)
use psb_penv_mod
use psb_realloc_mod
use psb_indx_map_mod, psb_protect_name => psi_symm_dep_list_inrv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(inout) :: rvsz(0:)
@ -123,12 +123,12 @@ subroutine psi_symm_dep_list_norv(adj,ctxt,info)
use psb_penv_mod
use psb_realloc_mod
use psb_indx_map_mod, psb_protect_name => psi_symm_dep_list_norv
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_ipk_), allocatable, intent(inout) :: adj(:)

4
base/internals/psi_xtr_loc_dl.F90
Unescape Escape View File

@ -109,7 +109,7 @@ subroutine psi_i_xtr_loc_dl(ctxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info)
! dependence list of current process
!
use psi_mod, psb_protect_name => psi_i_xtr_loc_dl
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
use psb_penv_mod
@ -118,7 +118,7 @@ subroutine psi_i_xtr_loc_dl(ctxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info)
use psb_desc_mod
use psb_sort_mod
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
! ....scalar parameters...

2
base/modules/Makefile
Unescape Escape View File

@ -124,7 +124,7 @@ FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG).
objs: $(MODULES) $(OBJS) $(MPFOBJS)
/bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR)
/bin/cp -p $(CPUPDFLAG) psb_config.h $(INCDIR)
/bin/cp -p $(CPUPDFLAG) psb_config.h psb_types.h $(INCDIR)
lib: objs $(LIBDIR)/$(LIBNAME)

219
base/modules/auxil/psb_c_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_c_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='complex(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_c_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_c_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_c_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_c_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='complex(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_c_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_c_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='complex(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_c_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_c_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_c_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_c_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_c_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_c_rk1
subroutine psb_ab_cpy_c_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_c_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_c_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_c_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_c_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

219
base/modules/auxil/psb_d_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_d_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='real(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_d_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_d_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_d_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_d_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='real(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_d_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_d_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='real(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_d_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_d_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_d_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_d_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_d_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_d_rk1
subroutine psb_ab_cpy_d_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_d_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_d_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_d_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_d_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

219
base/modules/auxil/psb_e_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_e_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_epk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_e_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_e_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_e_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_e_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_epk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_e_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_e_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_epk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_e_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_e_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='integer(psb_epk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_e_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_e_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_e_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_epk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_e_rk1
subroutine psb_ab_cpy_e_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_e_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_e_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_e_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_e_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

219
base/modules/auxil/psb_i2_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_i2_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_i2pk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_i2_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_i2_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_i2_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_i2_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_i2pk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_i2_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_i2_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_i2pk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_i2_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_i2_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='integer(psb_i2pk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_i2_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_i2_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_i2_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_i2pk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_i2_rk1
subroutine psb_ab_cpy_i2_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_i2_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_i2_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_i2_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_i2_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

219
base/modules/auxil/psb_m_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_m_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_mpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_m_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_m_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_m_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_m_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_mpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_m_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_m_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_mpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_m_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_m_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='integer(psb_mpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_m_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_m_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_m_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='integer(psb_mpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_m_rk1
subroutine psb_ab_cpy_m_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_m_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_m_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_m_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_m_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

219
base/modules/auxil/psb_s_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_s_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='real(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='real(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_s_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='real(psb_spk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_s_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='real(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='real(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_s_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='real(psb_spk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_s_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='real(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='real(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_s_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='real(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_s_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='real(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='real(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_s_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='real(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_s_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='real(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_s_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_s_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_spk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_spk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_s_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='real(psb_spk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_s_rk1
subroutine psb_ab_cpy_s_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_s_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_s_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_s_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_s_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

219
base/modules/auxil/psb_z_realloc_mod.F90
Unescape Escape View File

@ -154,30 +154,32 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_m_z_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='complex(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_z_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len*1_psb_lpk_/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(dim,len)
do i=lb_-1+dim+1,lb_-1+len
@ -239,7 +241,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_m_z_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -248,27 +252,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_m_z_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, l_err=(/len1*1_psb_lpk_*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
!$omp parallel do private(i) shared(lb1_,dim,len1)
do i=lb1_-1+dim+1,lb1_-1+len1
@ -325,30 +328,33 @@ Contains
end if
ub_ = lb_ + len-1
#if defined(PSB_OPENMP)
!$omp critical(r_e_z_rk1)
#endif
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='complex(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_z_rk1)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
@ -407,7 +413,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_e_z_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -416,27 +424,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='complex(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_e_z_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/(len1*len2)/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -498,7 +505,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_me_z_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -507,27 +516,28 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name,e_err=(/len1*len2/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_me_z_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -589,7 +599,9 @@ Contains
goto 9999
end if
#if defined(PSB_OPENMP)
!$omp critical(r_em_z_rk2)
#endif
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -598,27 +610,26 @@ Contains
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
if (info == psb_success_) then
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
#if defined(PSB_OPENMP)
!$omp end critical(r_em_z_rk2)
#endif
if (info /= psb_success_) then
err=4025
call psb_errpush(err,name, e_err=(/len1*len2/), &
& a_err='complex(psb_dpk_)')
goto 9999
end if
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
@ -715,8 +726,6 @@ Contains
End Subroutine psb_r_e_2_z_rk1
subroutine psb_ab_cpy_z_s(vin,vout,info)
use psb_error_mod
@ -999,8 +1008,9 @@ Contains
isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP)
!$OMP CRITICAL
#if defined(PSB_OPENMP)
!$omp critical(m_sz_z_rk1)
isz = psb_size(v)
if (len > isz) then
if (present(newsz)) then
isz = max(len+1,1,newsz)
@ -1012,7 +1022,9 @@ Contains
call psb_realloc(isz,v,info,pad=pad)
end if
!$OMP END CRITICAL
if (info /= psb_success_) &
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(m_sz_z_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
@ -1028,7 +1040,6 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end if
@ -1075,6 +1086,28 @@ Contains
end if
isz = psb_size(v)
If (len > isz) Then
#if defined(PSB_OPENMP)
!$omp critical(e_sz_z_rk1)
isz = psb_size(v)
If (len > isz) Then
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
end If
if (info /= psb_success_)&
& write(0,*) 'Error from realloc ',info,len,isz
!$omp end critical(e_sz_z_rk1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#else
if (present(newsz)) then
isz = max(len+1,1,newsz)
else if (present(addsz)) then
@ -1082,13 +1115,13 @@ Contains
else
isz = max(len,1,int(1.25*isz))
endif
call psb_realloc(isz,v,info,pad=pad)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
End If
#endif
end If
call psb_erractionrestore(err_act)

2
base/modules/desc/psb_desc_mod.F90
Unescape Escape View File

@ -289,7 +289,7 @@ module psb_desc_mod
module procedure psb_i_cd_set_large_threshold
end interface psb_cd_set_large_threshold
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
interface psb_cd_set_large_threshold
module procedure psb_l_cd_set_large_threshold
end interface psb_cd_set_large_threshold

6
base/modules/desc/psb_gen_block_map_mod.F90
Unescape Escape View File

@ -109,13 +109,13 @@ module psb_gen_block_map_mod
& block_lg2ls1_ins, block_lg2ls2_ins, block_lg2lv1_ins, block_lg2lv2_ins, &
& block_clone, block_reinit,&
& block_get_fmt, i_gen_block_search
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
private :: l_gen_block_search
#endif
interface gen_block_search
module procedure i_gen_block_search
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
module procedure l_gen_block_search
#endif
end interface gen_block_search
@ -1382,7 +1382,7 @@ contains
return
end function i_gen_block_search
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
function l_gen_block_search(key,n,v) result(ipos)
implicit none

127
base/modules/desc/psb_hash_map_mod.F90
Unescape Escape View File

@ -106,7 +106,7 @@ module psb_hash_map_mod
& hash_bld_g2l_map, hash_inner_cnvs2, hash_inner_cnvs1, &
& hash_inner_cnv2, hash_inner_cnv1, hash_row_extendable
integer(psb_ipk_), private :: laddsz=500
integer(psb_ipk_), private :: psb_laddsz=500
interface hash_inner_cnv
module procedure hash_inner_cnvs2, hash_inner_cnv2,&
@ -648,7 +648,7 @@ contains
use psb_realloc_mod
use psb_sort_mod
use psb_penv_mod
#ifdef OPENMP
#ifdef PSB_OPENMP
use omp_lib
#endif
@ -668,7 +668,7 @@ contains
character(len=20) :: name,ch_err
logical, allocatable :: mask_(:)
!!$ logical :: use_openmp = .true.
#ifdef OPENMP
#ifdef PSB_OPENMP
integer(kind = OMP_lock_kind) :: ins_lck
#endif
logical, volatile :: isLoopValid
@ -698,14 +698,15 @@ contains
mglob = idxmap%get_gr()
nrow = idxmap%get_lr()
!write(0,*) me,name,' before loop ',psb_errstatus_fatal()
#if defined(OPENMP)
#if 0&& defined(PSB_OPENMP)
!$omp critical(hash_g2l_ins)
isLoopValid = .true.
if (idxmap%is_bld()) then
if (present(lidx)) then
if (present(mask)) then
! $ o m p parallel do default(none) schedule(dynamic) &
! $ o m p shared(lidx,mask,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ o m p shared(lidx,mask,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,psb_laddsz) &
! $ o m p private(i,ip,lip,tlip,nxt,info) &
! $ o m p reduction(.AND.:isLoopValid)
do i = 1, is
@ -722,7 +723,7 @@ contains
idx(i) = lip
info = psb_success_
else
!$omp critical(hash_g2l_ins)
! $ o m p critical(hash_g2l_ins)
tlip = lip
nxt = lidx(i)
if (nxt <= nrow) then
@ -738,9 +739,10 @@ contains
if (info >=0) then
if (nxt == lip) then
call psb_ensure_size(lip,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
info=1
write(0,*)'Problem 1:',info,lip,size(idxmap%loc_to_glob)
info=lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -758,7 +760,7 @@ contains
end if
end if
endif
!$omp end critical(hash_g2l_ins)
! $ o m p end critical(hash_g2l_ins)
end if
else
idx(i) = -1
@ -769,7 +771,7 @@ contains
else if (.not.present(mask)) then
! $ o m p parallel do default(none) schedule(dynamic) &
! $ o m p shared(lidx,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ o m p shared(lidx,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,psb_laddsz) &
! $ o m p private(i,ip,lip,tlip,nxt,info) &
! $ o m p reduction(.AND.:isLoopValid)
do i = 1, is
@ -785,7 +787,7 @@ contains
idx(i) = lip
info = psb_success_
else
!$omp critical(hash_g2l_ins)
! $ o m p critical(hash_g2l_ins)
tlip = lip
nxt = lidx(i)
if (nxt <= nrow) then
@ -801,9 +803,10 @@ contains
if (info >=0) then
if (nxt == lip) then
call psb_ensure_size(lip,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
info=1
write(0,*)'Problem 2:',info,lip,size(idxmap%loc_to_glob)
info=lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -821,7 +824,7 @@ contains
end if
end if
endif
!$omp end critical(hash_g2l_ins)
! $ o m p end critical(hash_g2l_ins)
end if
enddo
! $ o m p end parallel do
@ -831,7 +834,7 @@ contains
if (present(mask)) then
! $ o m p parallel do default(none) schedule(dynamic) &
! $ o m p shared(mask,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ o m p shared(mask,name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,psb_laddsz) &
! $ o m p private(i,ip,lip,tlip,nxt,info) &
! $ o m p reduction(.AND.:isLoopValid)
do i = 1, is
@ -848,7 +851,7 @@ contains
idx(i) = lip
info = psb_success_
else
!$omp critical(hash_g2l_ins)
! $ o m p critical(hash_g2l_ins)
ncol = idxmap%get_lc()
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
@ -859,11 +862,14 @@ contains
call psb_hash_searchinskey(ip,tlip,nxt,idxmap%hash,info)
lip = tlip
if (info >=0) then
if (nxt == lip) then
call psb_ensure_size(lip,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
if (nxt == lip) then
if (lip > size(idxmap%loc_to_glob)) then
call psb_ensure_size(lip,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=psb_laddsz)
end if
if (info /= psb_success_) then
info=1
write(0,*)'Problem 3:',info,lip,size(idxmap%loc_to_glob)
info=lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -879,7 +885,7 @@ contains
isLoopValid = .false.
end if
end if
!$omp end critical(hash_g2l_ins)
! $ o m p end critical(hash_g2l_ins)
end if
else
idx(i) = -1
@ -890,7 +896,7 @@ contains
else if (.not.present(mask)) then
! $ o m p parallel do default(none) schedule(dynamic) &
! $ o m p shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,laddsz) &
! $ o m p shared(name,me,is,idx,ins_lck,mglob,idxmap,ncol,nrow,psb_laddsz) &
! $ o m p private(i,ip,lip,tlip,nxt,info) &
! $ o m p reduction(.AND.:isLoopValid)
do i = 1, is
@ -906,7 +912,7 @@ contains
idx(i) = lip
info = psb_success_
else
!$omp critical(hash_g2l_ins)
! $ o m p critical(hash_g2l_ins)
ncol = idxmap%get_lc()
nxt = ncol + 1
call hash_inner_cnv(ip,lip,idxmap%hashvmask,idxmap%hashv,&
@ -919,9 +925,10 @@ contains
if (info >=0) then
if (nxt == lip) then
call psb_ensure_size(lip,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
info=1
write(0,*)'Problem 4:',info,lip,size(idxmap%loc_to_glob)
info=lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -937,7 +944,7 @@ contains
isLoopValid = .false.
end if
end if
!$omp end critical(hash_g2l_ins)
! $ o m p end critical(hash_g2l_ins)
end if
enddo
! $ o m p end parallel do
@ -948,6 +955,7 @@ contains
idx = -1
info = -1
end if
!$omp end critical(hash_g2l_ins)
if (.not. isLoopValid) goto 9999
#else
!!$ else if (.not.use_openmp) then
@ -978,9 +986,11 @@ contains
if (nxt == tlip) then
ncol = max(ncol,nxt)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
!write(0,*) 'Error spot'
!write(0,*) 'Error spot'
write(0,*)'Problem 5:',info,lip,size(idxmap%loc_to_glob)
info = lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -1026,10 +1036,11 @@ contains
if (nxt == lip) then
ncol = max(nxt,ncol)
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
info=1
!write(0,*) 'Error spot'
write(0,*)'Problem 6:',info,lip,size(idxmap%loc_to_glob)
info = lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -1073,10 +1084,10 @@ contains
if (nxt == lip) then
ncol = nxt
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
info=1
write(0,*) 'Error spot 5'
write(0,*)'Problem 7:',info,lip,size(idxmap%loc_to_glob)
info = lip
call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='psb_ensure_size',i_err=(/info/))
isLoopValid = .false.
@ -1117,10 +1128,10 @@ contains
if (nxt == lip) then
ncol = nxt
call psb_ensure_size(ncol,idxmap%loc_to_glob,info,&
& pad=-1_psb_lpk_,addsz=laddsz)
& pad=-1_psb_lpk_,addsz=psb_laddsz)
if (info /= psb_success_) then
info=1
write(0,*) 'Error spot 6'
write(0,*)'Problem 8:',info,lip,size(idxmap%loc_to_glob)
info = lip
ch_err='psb_ensure_size'
call psb_errpush(psb_err_from_subroutine_ai_,name,&
&a_err=ch_err,i_err=(/info,izero,izero,izero,izero/))
@ -1206,11 +1217,9 @@ contains
! To be implemented
integer(psb_ipk_) :: iam, np
integer(psb_ipk_) :: i, nlu, nl, int_err(5)
integer(psb_lpk_) :: m, nrt
integer(psb_lpk_), allocatable :: vlu(:)
integer(psb_lpk_), allocatable :: ix(:)
integer(psb_lpk_) :: m, nrt
character(len=20), parameter :: name='hash_map_init_vl'
real(psb_dpk_) :: t0, t1, t2,t3, t4, t5
info = 0
call psb_info(ctxt,iam,np)
if (np < 0) then
@ -1218,7 +1227,6 @@ contains
info = -1
return
end if
nl = size(vl)
m = maxval(vl(1:nl))
@ -1226,46 +1234,15 @@ contains
call psb_sum(ctxt,nrt)
call psb_max(ctxt,m)
allocate(vlu(nl), ix(nl), stat=info)
if (info /= 0) then
info = -1
return
end if
do i=1,nl
if ((vl(i)<1).or.(vl(i)>m)) then
info = psb_err_entry_out_of_bounds_
int_err(1) = i
int_err(2) = vl(i)
int_err(3) = nl
int_err(4) = m
exit
endif
vlu(i) = vl(i)
end do
if ((m /= nrt).and.(iam == psb_root_)) then
write(psb_err_unit,*) trim(name),&
& ' Warning: globalcheck=.false., but there is a mismatch'
& ' Warning: we got to hash_init_vl but there is a mismatch'
write(psb_err_unit,*) trim(name),&
& ' : in the global sizes!',m,nrt
end if
call psb_msort(vlu,ix)
nlu = 1
do i=2,nl
if (vlu(i) /= vlu(nlu)) then
nlu = nlu + 1
vlu(nlu) = vlu(i)
ix(nlu) = ix(i)
end if
end do
call psb_msort(ix(1:nlu),vlu(1:nlu),flag=psb_sort_keep_idx_)
call hash_init_vlu(idxmap,ctxt,m,nl,vl,info)
nlu = nl
call hash_init_vlu(idxmap,ctxt,m,nlu,vlu,info)
end subroutine hash_init_vl
subroutine hash_init_vg(idxmap,ctxt,vg,info)
@ -1354,7 +1331,7 @@ contains
idxmap%global_cols = ntot
idxmap%local_rows = nl
idxmap%local_cols = nl
idxmap%ctxt = ctxt
idxmap%ctxt = ctxt
idxmap%state = psb_desc_bld_
idxmap%mpic = psb_get_mpi_comm(ctxt)

8
base/modules/desc/psb_hash_mod.F90
Unescape Escape View File

@ -71,7 +71,7 @@ module psb_hash_mod
integer(psb_ipk_), parameter :: HashNotFound = -256
interface psb_hashval
#if defined(IPK4)
#if defined(PSB_IPK4)
function psb_c_hashval_32(key) bind(c) result(res)
import psb_c_ipk_
implicit none
@ -79,7 +79,7 @@ module psb_hash_mod
integer(psb_c_ipk_) :: res
end function psb_c_hashval_32
#endif
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
function psb_c_hashval_64_32(key) bind(c) result(res)
import psb_c_ipk_, psb_c_lpk_
implicit none
@ -87,7 +87,7 @@ module psb_hash_mod
integer(psb_c_ipk_) :: res
end function psb_c_hashval_64_32
#endif
#if defined(IPK8)
#if defined(PSB_IPK8)
function psb_c_hashval_64(key) bind(c) result(res)
import psb_c_ipk_
implicit none
@ -115,7 +115,7 @@ module psb_hash_mod
module procedure psb_hash_lsearchkey
end interface psb_hash_searchkey
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
interface psb_hash_init
module procedure psb_hash_init_v, psb_hash_init_n
end interface

4
base/modules/desc/psb_indx_map_mod.F90
Unescape Escape View File

@ -153,7 +153,7 @@ module psb_indx_map_mod
procedure, pass(idxmap) :: set_gci => base_set_gci
procedure, pass(idxmap) :: set_grl => base_set_grl
procedure, pass(idxmap) :: set_gcl => base_set_gcl
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
generic, public :: set_gr => set_grl, set_gri
generic, public :: set_gc => set_gcl, set_gci
#else
@ -165,7 +165,7 @@ module psb_indx_map_mod
procedure, pass(idxmap) :: set_lci => base_set_lci
procedure, pass(idxmap) :: set_lcl => base_set_lcl
procedure, pass(idxmap) :: inc_lc => base_inc_lc
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
generic, public :: set_lr => set_lrl, set_lri
generic, public :: set_lc => set_lcl, set_lci
#else

16
base/modules/desc/psb_list_map_mod.F90
Unescape Escape View File

@ -528,7 +528,7 @@ contains
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
@ -573,7 +573,7 @@ contains
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
@ -617,7 +617,7 @@ contains
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
@ -658,7 +658,7 @@ contains
if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idx(i))
if (ix < 0) then
@ -745,7 +745,7 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
@ -786,7 +786,7 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
@ -829,7 +829,7 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
@ -870,7 +870,7 @@ contains
if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$OMP CRITICAL(LISTINS)
ix = idxmap%glob_to_loc(idxin(i))
if (ix < 0) then

162
base/modules/penv/psi_c_collective_mod.F90
Unescape Escape View File

@ -89,11 +89,11 @@ contains
! gather
!
subroutine psb_cgather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -107,7 +107,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -157,11 +157,11 @@ contains
end subroutine psb_cgather_s
subroutine psb_cgather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -175,7 +175,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -225,11 +225,11 @@ contains
end subroutine psb_cgather_v
subroutine psb_cgatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -245,7 +245,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -334,11 +334,11 @@ contains
!
subroutine psb_csums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -352,7 +352,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -410,11 +410,11 @@ contains
end subroutine psb_csums
subroutine psb_csumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -428,7 +428,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -487,11 +487,11 @@ contains
end subroutine psb_csumv
subroutine psb_csumm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -505,7 +505,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -568,11 +568,11 @@ contains
!
subroutine psb_camxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -586,7 +586,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -645,11 +645,11 @@ contains
end subroutine psb_camxs
subroutine psb_camxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -663,7 +663,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -722,11 +722,11 @@ contains
end subroutine psb_camxv
subroutine psb_camxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -740,7 +740,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -802,11 +802,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_camns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -820,7 +820,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -879,11 +879,11 @@ contains
end subroutine psb_camns
subroutine psb_camnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -897,7 +897,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -956,11 +956,11 @@ contains
end subroutine psb_camnv
subroutine psb_camnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -974,7 +974,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1037,11 +1037,11 @@ contains
! BCAST Broadcast
!
subroutine psb_cbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1056,7 +1056,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1092,11 +1092,11 @@ contains
end subroutine psb_cbcasts
subroutine psb_cbcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1110,7 +1110,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1147,11 +1147,11 @@ contains
end subroutine psb_cbcastv
subroutine psb_cbcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1165,7 +1165,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1209,11 +1209,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_cscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1227,7 +1227,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1260,11 +1260,11 @@ contains
end subroutine psb_cscan_sums
subroutine psb_cexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1279,7 +1279,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1314,11 +1314,11 @@ contains
end subroutine psb_cexscan_sums
subroutine psb_cscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1332,7 +1332,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
complex(psb_spk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1365,11 +1365,11 @@ contains
end subroutine psb_cscan_sumv
subroutine psb_cexscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1384,7 +1384,7 @@ contains
logical :: collective_start, collective_end, collective_sync
complex(psb_spk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1457,17 +1457,17 @@ contains
subroutine psb_c_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
complex(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
complex(psb_spk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1494,14 +1494,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1514,14 +1514,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -1540,17 +1540,17 @@ contains
subroutine psb_c_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
complex(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
complex(psb_spk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1577,14 +1577,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1597,14 +1597,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_c_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_c_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_c_p2p_mod
contains
subroutine psb_csnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_csndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_csndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_csndm
subroutine psb_crcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_crcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
complex(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_c_spk_,src,psb_complex_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_crcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

48
base/modules/penv/psi_collective_mod.F90
Unescape Escape View File

@ -53,11 +53,11 @@ module psi_collective_mod
contains
subroutine psb_hbcasts(ctxt,dat,root,length)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -66,7 +66,7 @@ contains
integer(psb_mpk_) :: iam, np, root_,length_,info, icomm
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
if (present(root)) then
root_ = root
else
@ -86,11 +86,11 @@ contains
end subroutine psb_hbcasts
subroutine psb_hbcastv(ctxt,dat,root)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -100,7 +100,7 @@ contains
integer(psb_mpk_) :: iam, np, root_, icomm
integer(psb_mpk_) :: length_,info, size_
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
if (present(root)) then
root_ = root
else
@ -117,11 +117,11 @@ contains
end subroutine psb_hbcastv
subroutine psb_lbcasts(ctxt,dat,root)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -130,7 +130,7 @@ contains
integer(psb_mpk_) :: iam, np, root_,info, icomm
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
if (present(root)) then
root_ = root
else
@ -145,11 +145,11 @@ contains
end subroutine psb_lbcasts
subroutine psb_lallreduceand(ctxt,dat,rec)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -158,7 +158,7 @@ contains
integer(psb_mpk_) :: iam, np, info, icomm
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(rec)) then
@ -172,11 +172,11 @@ end subroutine psb_lallreduceand
subroutine psb_lbcastv(ctxt,dat,root)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -185,7 +185,7 @@ end subroutine psb_lallreduceand
integer(psb_mpk_) :: iam, np, root_,info, icomm
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
if (present(root)) then
root_ = root
else
@ -201,11 +201,11 @@ end subroutine psb_lallreduceand
#if defined(SHORT_INTEGERS)
subroutine psb_i2sums(ctxt,dat,root)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: ctxt
@ -216,7 +216,7 @@ end subroutine psb_lallreduceand
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -239,11 +239,11 @@ end subroutine psb_lallreduceand
subroutine psb_i2sumv(ctxt,dat,root)
use psb_realloc_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: ctxt
@ -254,7 +254,7 @@ end subroutine psb_lallreduceand
integer(psb_mpk_) :: iam, np, info, icomm
integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -283,11 +283,11 @@ end subroutine psb_lallreduceand
subroutine psb_i2summ(ctxt,dat,root)
use psb_realloc_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in) :: ctxt
@ -299,7 +299,7 @@ end subroutine psb_lallreduceand
integer(psb_ipk_) :: iinfo
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then

210
base/modules/penv/psi_d_collective_mod.F90
Unescape Escape View File

@ -102,11 +102,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_dmaxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -121,7 +121,7 @@ contains
logical :: collective_start, collective_end, collective_sync
real(psb_dpk_) :: dat_
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -176,11 +176,11 @@ contains
end subroutine psb_dmaxs
subroutine psb_dmaxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -196,7 +196,7 @@ contains
real(psb_dpk_) :: dat_(1) ! This is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -255,11 +255,11 @@ contains
end subroutine psb_dmaxv
subroutine psb_dmaxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -275,7 +275,7 @@ contains
real(psb_dpk_) :: dat_(1,1) ! this is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -337,11 +337,11 @@ contains
! MIN: Minimum Value
!
subroutine psb_dmins(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -355,7 +355,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -411,11 +411,11 @@ contains
end subroutine psb_dmins
subroutine psb_dminv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -429,7 +429,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -488,11 +488,11 @@ contains
end subroutine psb_dminv
subroutine psb_dminm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -506,7 +506,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -571,11 +571,11 @@ contains
!
! !!!!!!!!!!!!
subroutine psb_d_nrm2s(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -589,7 +589,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -648,11 +648,11 @@ contains
end subroutine psb_d_nrm2s
subroutine psb_d_nrm2v(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -666,7 +666,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -729,11 +729,11 @@ contains
! gather
!
subroutine psb_dgather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -747,7 +747,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -797,11 +797,11 @@ contains
end subroutine psb_dgather_s
subroutine psb_dgather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -815,7 +815,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -865,11 +865,11 @@ contains
end subroutine psb_dgather_v
subroutine psb_dgatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -885,7 +885,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -974,11 +974,11 @@ contains
!
subroutine psb_dsums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -992,7 +992,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1050,11 +1050,11 @@ contains
end subroutine psb_dsums
subroutine psb_dsumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1068,7 +1068,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1127,11 +1127,11 @@ contains
end subroutine psb_dsumv
subroutine psb_dsumm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1145,7 +1145,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1208,11 +1208,11 @@ contains
!
subroutine psb_damxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1226,7 +1226,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1285,11 +1285,11 @@ contains
end subroutine psb_damxs
subroutine psb_damxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1303,7 +1303,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1362,11 +1362,11 @@ contains
end subroutine psb_damxv
subroutine psb_damxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1380,7 +1380,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1442,11 +1442,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_damns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1460,7 +1460,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1519,11 +1519,11 @@ contains
end subroutine psb_damns
subroutine psb_damnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1537,7 +1537,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1596,11 +1596,11 @@ contains
end subroutine psb_damnv
subroutine psb_damnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1614,7 +1614,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1677,11 +1677,11 @@ contains
! BCAST Broadcast
!
subroutine psb_dbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1696,7 +1696,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1732,11 +1732,11 @@ contains
end subroutine psb_dbcasts
subroutine psb_dbcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1750,7 +1750,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1787,11 +1787,11 @@ contains
end subroutine psb_dbcastv
subroutine psb_dbcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1805,7 +1805,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1849,11 +1849,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_dscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1867,7 +1867,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1900,11 +1900,11 @@ contains
end subroutine psb_dscan_sums
subroutine psb_dexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1919,7 +1919,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1954,11 +1954,11 @@ contains
end subroutine psb_dexscan_sums
subroutine psb_dscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1972,7 +1972,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
real(psb_dpk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -2005,11 +2005,11 @@ contains
end subroutine psb_dscan_sumv
subroutine psb_dexscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -2024,7 +2024,7 @@ contains
logical :: collective_start, collective_end, collective_sync
real(psb_dpk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -2097,17 +2097,17 @@ contains
subroutine psb_d_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
real(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2134,14 +2134,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2154,14 +2154,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -2180,17 +2180,17 @@ contains
subroutine psb_d_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
real(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2217,14 +2217,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2237,14 +2237,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_d_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_d_p2p_mod
contains
subroutine psb_dsnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
real(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_dsndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
real(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_dsndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_dsndm
subroutine psb_drcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_drcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
real(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_r_dpk_,src,psb_double_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_drcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

198
base/modules/penv/psi_e_collective_mod.F90
Unescape Escape View File

@ -99,11 +99,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_emaxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -118,7 +118,7 @@ contains
logical :: collective_start, collective_end, collective_sync
integer(psb_epk_) :: dat_
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -173,11 +173,11 @@ contains
end subroutine psb_emaxs
subroutine psb_emaxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -193,7 +193,7 @@ contains
integer(psb_epk_) :: dat_(1) ! This is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -252,11 +252,11 @@ contains
end subroutine psb_emaxv
subroutine psb_emaxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -272,7 +272,7 @@ contains
integer(psb_epk_) :: dat_(1,1) ! this is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -334,11 +334,11 @@ contains
! MIN: Minimum Value
!
subroutine psb_emins(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -352,7 +352,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -408,11 +408,11 @@ contains
end subroutine psb_emins
subroutine psb_eminv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -426,7 +426,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -485,11 +485,11 @@ contains
end subroutine psb_eminv
subroutine psb_eminm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -503,7 +503,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -567,11 +567,11 @@ contains
! gather
!
subroutine psb_egather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -585,7 +585,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -635,11 +635,11 @@ contains
end subroutine psb_egather_s
subroutine psb_egather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -653,7 +653,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -703,11 +703,11 @@ contains
end subroutine psb_egather_v
subroutine psb_egatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -723,7 +723,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -812,11 +812,11 @@ contains
!
subroutine psb_esums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -830,7 +830,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -888,11 +888,11 @@ contains
end subroutine psb_esums
subroutine psb_esumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -906,7 +906,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -965,11 +965,11 @@ contains
end subroutine psb_esumv
subroutine psb_esumm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -983,7 +983,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1046,11 +1046,11 @@ contains
!
subroutine psb_eamxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1064,7 +1064,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1123,11 +1123,11 @@ contains
end subroutine psb_eamxs
subroutine psb_eamxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1141,7 +1141,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1200,11 +1200,11 @@ contains
end subroutine psb_eamxv
subroutine psb_eamxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1218,7 +1218,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1280,11 +1280,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_eamns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1298,7 +1298,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1357,11 +1357,11 @@ contains
end subroutine psb_eamns
subroutine psb_eamnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1375,7 +1375,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1434,11 +1434,11 @@ contains
end subroutine psb_eamnv
subroutine psb_eamnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1452,7 +1452,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1515,11 +1515,11 @@ contains
! BCAST Broadcast
!
subroutine psb_ebcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1534,7 +1534,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1570,11 +1570,11 @@ contains
end subroutine psb_ebcasts
subroutine psb_ebcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1588,7 +1588,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1625,11 +1625,11 @@ contains
end subroutine psb_ebcastv
subroutine psb_ebcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1643,7 +1643,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1687,11 +1687,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_escan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1705,7 +1705,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1738,11 +1738,11 @@ contains
end subroutine psb_escan_sums
subroutine psb_eexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1757,7 +1757,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1792,11 +1792,11 @@ contains
end subroutine psb_eexscan_sums
subroutine psb_escan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1810,7 +1810,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
integer(psb_epk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1843,11 +1843,11 @@ contains
end subroutine psb_escan_sumv
subroutine psb_eexscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1862,7 +1862,7 @@ contains
logical :: collective_start, collective_end, collective_sync
integer(psb_epk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1935,17 +1935,17 @@ contains
subroutine psb_e_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_epk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_epk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_epk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1972,14 +1972,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1992,14 +1992,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -2018,17 +2018,17 @@ contains
subroutine psb_e_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_epk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_epk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_epk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2055,14 +2055,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2075,14 +2075,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_e_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_e_p2p_mod
contains
subroutine psb_esnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
integer(psb_epk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_esndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
integer(psb_epk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_esndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_esndm
subroutine psb_ercvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_ercvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
integer(psb_epk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_epk_,src,psb_int8_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_ercvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

198
base/modules/penv/psi_i2_collective_mod.F90
Unescape Escape View File

@ -99,11 +99,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_i2maxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -118,7 +118,7 @@ contains
logical :: collective_start, collective_end, collective_sync
integer(psb_i2pk_) :: dat_
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -173,11 +173,11 @@ contains
end subroutine psb_i2maxs
subroutine psb_i2maxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -193,7 +193,7 @@ contains
integer(psb_i2pk_) :: dat_(1) ! This is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -252,11 +252,11 @@ contains
end subroutine psb_i2maxv
subroutine psb_i2maxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -272,7 +272,7 @@ contains
integer(psb_i2pk_) :: dat_(1,1) ! this is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -334,11 +334,11 @@ contains
! MIN: Minimum Value
!
subroutine psb_i2mins(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -352,7 +352,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -408,11 +408,11 @@ contains
end subroutine psb_i2mins
subroutine psb_i2minv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -426,7 +426,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -485,11 +485,11 @@ contains
end subroutine psb_i2minv
subroutine psb_i2minm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -503,7 +503,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -567,11 +567,11 @@ contains
! gather
!
subroutine psb_i2gather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -585,7 +585,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -635,11 +635,11 @@ contains
end subroutine psb_i2gather_s
subroutine psb_i2gather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -653,7 +653,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -703,11 +703,11 @@ contains
end subroutine psb_i2gather_v
subroutine psb_i2gatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -723,7 +723,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -812,11 +812,11 @@ contains
!
subroutine psb_i2sums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -830,7 +830,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -888,11 +888,11 @@ contains
end subroutine psb_i2sums
subroutine psb_i2sumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -906,7 +906,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -965,11 +965,11 @@ contains
end subroutine psb_i2sumv
subroutine psb_i2summ(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -983,7 +983,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1046,11 +1046,11 @@ contains
!
subroutine psb_i2amxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1064,7 +1064,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1123,11 +1123,11 @@ contains
end subroutine psb_i2amxs
subroutine psb_i2amxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1141,7 +1141,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1200,11 +1200,11 @@ contains
end subroutine psb_i2amxv
subroutine psb_i2amxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1218,7 +1218,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1280,11 +1280,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_i2amns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1298,7 +1298,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1357,11 +1357,11 @@ contains
end subroutine psb_i2amns
subroutine psb_i2amnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1375,7 +1375,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1434,11 +1434,11 @@ contains
end subroutine psb_i2amnv
subroutine psb_i2amnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1452,7 +1452,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1515,11 +1515,11 @@ contains
! BCAST Broadcast
!
subroutine psb_i2bcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1534,7 +1534,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1570,11 +1570,11 @@ contains
end subroutine psb_i2bcasts
subroutine psb_i2bcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1588,7 +1588,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1625,11 +1625,11 @@ contains
end subroutine psb_i2bcastv
subroutine psb_i2bcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1643,7 +1643,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1687,11 +1687,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_i2scan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1705,7 +1705,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1738,11 +1738,11 @@ contains
end subroutine psb_i2scan_sums
subroutine psb_i2exscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1757,7 +1757,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1792,11 +1792,11 @@ contains
end subroutine psb_i2exscan_sums
subroutine psb_i2scan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1810,7 +1810,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
integer(psb_i2pk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1843,11 +1843,11 @@ contains
end subroutine psb_i2scan_sumv
subroutine psb_i2exscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1862,7 +1862,7 @@ contains
logical :: collective_start, collective_end, collective_sync
integer(psb_i2pk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1935,17 +1935,17 @@ contains
subroutine psb_i2_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_i2pk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_i2pk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_i2pk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1972,14 +1972,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1992,14 +1992,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -2018,17 +2018,17 @@ contains
subroutine psb_i2_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_i2pk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_i2pk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_i2pk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2055,14 +2055,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2075,14 +2075,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_i2pk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_i2_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_i2_p2p_mod
contains
subroutine psb_i2snds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
integer(psb_i2pk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_i2sndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
integer(psb_i2pk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_i2sndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_i2sndm
subroutine psb_i2rcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_i2rcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
integer(psb_i2pk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_i2pk_,src,psb_int2_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_i2rcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

198
base/modules/penv/psi_m_collective_mod.F90
Unescape Escape View File

@ -99,11 +99,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_mmaxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -118,7 +118,7 @@ contains
logical :: collective_start, collective_end, collective_sync
integer(psb_mpk_) :: dat_
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -173,11 +173,11 @@ contains
end subroutine psb_mmaxs
subroutine psb_mmaxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -193,7 +193,7 @@ contains
integer(psb_mpk_) :: dat_(1) ! This is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -252,11 +252,11 @@ contains
end subroutine psb_mmaxv
subroutine psb_mmaxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -272,7 +272,7 @@ contains
integer(psb_mpk_) :: dat_(1,1) ! this is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -334,11 +334,11 @@ contains
! MIN: Minimum Value
!
subroutine psb_mmins(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -352,7 +352,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -408,11 +408,11 @@ contains
end subroutine psb_mmins
subroutine psb_mminv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -426,7 +426,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -485,11 +485,11 @@ contains
end subroutine psb_mminv
subroutine psb_mminm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -503,7 +503,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -567,11 +567,11 @@ contains
! gather
!
subroutine psb_mgather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -585,7 +585,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -635,11 +635,11 @@ contains
end subroutine psb_mgather_s
subroutine psb_mgather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -653,7 +653,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -703,11 +703,11 @@ contains
end subroutine psb_mgather_v
subroutine psb_mgatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -723,7 +723,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -812,11 +812,11 @@ contains
!
subroutine psb_msums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -830,7 +830,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -888,11 +888,11 @@ contains
end subroutine psb_msums
subroutine psb_msumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -906,7 +906,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -965,11 +965,11 @@ contains
end subroutine psb_msumv
subroutine psb_msumm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -983,7 +983,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1046,11 +1046,11 @@ contains
!
subroutine psb_mamxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1064,7 +1064,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1123,11 +1123,11 @@ contains
end subroutine psb_mamxs
subroutine psb_mamxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1141,7 +1141,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1200,11 +1200,11 @@ contains
end subroutine psb_mamxv
subroutine psb_mamxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1218,7 +1218,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1280,11 +1280,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_mamns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1298,7 +1298,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1357,11 +1357,11 @@ contains
end subroutine psb_mamns
subroutine psb_mamnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1375,7 +1375,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1434,11 +1434,11 @@ contains
end subroutine psb_mamnv
subroutine psb_mamnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1452,7 +1452,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1515,11 +1515,11 @@ contains
! BCAST Broadcast
!
subroutine psb_mbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1534,7 +1534,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1570,11 +1570,11 @@ contains
end subroutine psb_mbcasts
subroutine psb_mbcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1588,7 +1588,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1625,11 +1625,11 @@ contains
end subroutine psb_mbcastv
subroutine psb_mbcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1643,7 +1643,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1687,11 +1687,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_mscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1705,7 +1705,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1738,11 +1738,11 @@ contains
end subroutine psb_mscan_sums
subroutine psb_mexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1757,7 +1757,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1792,11 +1792,11 @@ contains
end subroutine psb_mexscan_sums
subroutine psb_mscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1810,7 +1810,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
integer(psb_mpk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1843,11 +1843,11 @@ contains
end subroutine psb_mscan_sumv
subroutine psb_mexscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1862,7 +1862,7 @@ contains
logical :: collective_start, collective_end, collective_sync
integer(psb_mpk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1935,17 +1935,17 @@ contains
subroutine psb_m_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_mpk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1972,14 +1972,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1992,14 +1992,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -2018,17 +2018,17 @@ contains
subroutine psb_m_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
integer(psb_mpk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
integer(psb_mpk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2055,14 +2055,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2075,14 +2075,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_m_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_m_p2p_mod
contains
subroutine psb_msnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
integer(psb_mpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_msndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
integer(psb_mpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_msndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_msndm
subroutine psb_mrcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_mrcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
integer(psb_mpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_mpk_,src,psb_int4_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_mrcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

48
base/modules/penv/psi_p2p_mod.F90
Unescape Escape View File

@ -66,11 +66,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_lsnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -78,7 +78,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
logical, allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -89,11 +89,11 @@ contains
subroutine psb_lsndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -102,7 +102,7 @@ contains
logical, allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -113,11 +113,11 @@ contains
subroutine psb_lsndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -128,7 +128,7 @@ contains
integer(psb_mpk_) :: info
integer(psb_ipk_) :: i,j,k,m_,n_
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -150,11 +150,11 @@ contains
subroutine psb_hsnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -162,7 +162,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
character(len=1), allocatable :: dat_(:)
integer(psb_mpk_) :: info, l, i
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
l = len(dat)
@ -182,11 +182,11 @@ contains
subroutine psb_lrcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -194,7 +194,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -205,11 +205,11 @@ contains
subroutine psb_lrcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -217,7 +217,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,icomm,status,info)
@ -228,11 +228,11 @@ contains
subroutine psb_lrcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -242,7 +242,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_ipk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
icomm = psb_get_mpi_comm(ctxt)
@ -269,11 +269,11 @@ contains
subroutine psb_hrcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -282,7 +282,7 @@ contains
character(len=1), allocatable :: dat_(:)
integer(psb_mpk_) :: info, l, i
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
l = len(dat)

107
base/modules/penv/psi_penv_mod.F90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! Provide a fake mpi module just to keep the compiler(s) happy.
module mpi
use psb_const_mod
@ -55,6 +55,7 @@ module mpi
interface
function mpi_wtime() result(res) bind(c,name='mpi_wtime')
import
real(c_double) :: res
end function mpi_wtime
end interface
@ -262,7 +263,7 @@ module psi_penv_mod
interface psb_info
module procedure psb_info_mpik
end interface
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
interface psb_info
module procedure psb_info_epk
end interface
@ -284,7 +285,7 @@ module psi_penv_mod
module procedure psb_m_get_mpi_rank!, psb_e_get_mpi_rank
end interface psb_get_mpi_rank
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
integer(psb_mpk_), private, save :: nctxt=0
#else
@ -340,11 +341,11 @@ contains
end subroutine psb_init_queue
subroutine psb_wait_buffer(node, info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_buffer_node), intent(inout) :: node
@ -356,11 +357,11 @@ contains
end subroutine psb_wait_buffer
subroutine psb_test_buffer(node, flag, info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_buffer_node), intent(inout) :: node
@ -368,7 +369,7 @@ contains
integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: status(mpi_status_size), minfo
minfo = mpi_success
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
flag = .true.
#else
call mpi_test(node%request,flag,status,minfo)
@ -475,11 +476,11 @@ contains
!
! !!!!!!!!!!!!!!!!!
subroutine psi_msnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -514,11 +515,11 @@ contains
subroutine psi_esnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -551,11 +552,11 @@ contains
end subroutine psi_esnd
subroutine psi_i2snd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -588,11 +589,11 @@ contains
end subroutine psi_i2snd
subroutine psi_ssnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -625,11 +626,11 @@ contains
end subroutine psi_ssnd
subroutine psi_dsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -662,11 +663,11 @@ contains
end subroutine psi_dsnd
subroutine psi_csnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -699,11 +700,11 @@ contains
end subroutine psi_csnd
subroutine psi_zsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -737,11 +738,11 @@ contains
subroutine psi_logsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -775,11 +776,11 @@ contains
subroutine psi_hsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -850,11 +851,11 @@ contains
end subroutine psi_get_sizes
subroutine psi_register_mpi_extras(info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_) :: info
@ -870,18 +871,18 @@ contains
if (info == 0) call mpi_type_create_f90_complex(psb_spk_p_,psb_spk_r_, psb_mpi_c_spk_,info)
if (info == 0) call mpi_type_create_f90_complex(psb_dpk_p_,psb_dpk_r_, psb_mpi_c_dpk_,info)
#else
#if defined(IPK4) && defined(LPK4)
#if defined(PSB_IPK4) && defined(PSB_LPK4)
psb_mpi_ipk_ = mpi_integer4
psb_mpi_lpk_ = mpi_integer4
#elif defined(IPK4) && defined(LPK8)
#elif defined(PSB_IPK4) && defined(PSB_LPK8)
psb_mpi_ipk_ = mpi_integer4
psb_mpi_lpk_ = mpi_integer8
#elif defined(IPK8) && defined(LPK8)
#elif defined(PSB_IPK8) && defined(PSB_LPK8)
psb_mpi_ipk_ = mpi_integer8
psb_mpi_lpk_ = mpi_integer8
#else
! This should never happen
write(psb_err_unit,*) 'Warning: an impossible IPK/LPK combination.'
write(psb_err_unit,*) 'Warning: an impossible PSB_IPK/PSB_LPK combination.'
write(psb_err_unit,*) 'Something went wrong at configuration time.'
psb_mpi_ipk_ = -1
psb_mpi_lpk_ = -1
@ -895,7 +896,7 @@ contains
psb_mpi_c_dpk_ = mpi_double_complex
#endif
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (info == 0) call mpi_op_create(psi_i2amx_op,.true.,mpi_i2amx_op,info)
if (info == 0) call mpi_op_create(psi_i2amn_op,.true.,mpi_i2amn_op,info)
@ -917,7 +918,7 @@ contains
end subroutine psi_register_mpi_extras
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_info_epk(ctxt,iam,np)
type(psb_ctxt_type), intent(in) :: ctxt
@ -940,11 +941,11 @@ contains
use psb_mat_mod
use psb_vect_mod
! !$ use psb_rsb_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(out) :: ctxt
@ -960,7 +961,7 @@ contains
!
call psb_set_debug_unit(psb_err_unit)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
ctxt%ctxt = nctxt ! allocate on assignment
nctxt = nctxt + 1
@ -1079,11 +1080,11 @@ contains
use psb_mat_mod
use psb_vect_mod
! !$ use psb_rsb_mod
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(inout) :: ctxt
@ -1108,7 +1109,7 @@ contains
! !$ call psb_error(ctxt)
! !$ endif
! !$ endif
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! Under serial mode, CLOSE has no effect, but reclaim
! the used ctxt number.
nctxt = max(0, nctxt - 1)
@ -1153,17 +1154,17 @@ contains
subroutine psb_barrier_mpik(ctxt)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_) :: info
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
if (allocated(ctxt%ctxt)) then
if (ctxt%ctxt /= mpi_comm_null) call mpi_barrier(ctxt%ctxt, info)
end if
@ -1174,11 +1175,11 @@ contains
function psb_wtime()
use psb_const_mod
! use mpi_constants
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_dpk_) :: psb_wtime
@ -1193,7 +1194,7 @@ contains
integer(psb_mpk_) :: code, info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
stop
#else
if (present(errc)) then
@ -1209,11 +1210,11 @@ contains
subroutine psb_info_mpik(ctxt,iam,np)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
@ -1241,7 +1242,7 @@ contains
! it's valid or not.
!
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
iam = 0
np = 1
#else
@ -1268,11 +1269,11 @@ contains
function psb_m_get_mpi_comm(ctxt) result(comm)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt
@ -1290,11 +1291,11 @@ contains
end function psb_m_get_mpi_rank
subroutine psb_get_mpicomm(ctxt,comm)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt

210
base/modules/penv/psi_s_collective_mod.F90
Unescape Escape View File

@ -102,11 +102,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_smaxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -121,7 +121,7 @@ contains
logical :: collective_start, collective_end, collective_sync
real(psb_spk_) :: dat_
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -176,11 +176,11 @@ contains
end subroutine psb_smaxs
subroutine psb_smaxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -196,7 +196,7 @@ contains
real(psb_spk_) :: dat_(1) ! This is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -255,11 +255,11 @@ contains
end subroutine psb_smaxv
subroutine psb_smaxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -275,7 +275,7 @@ contains
real(psb_spk_) :: dat_(1,1) ! this is a dummy
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -337,11 +337,11 @@ contains
! MIN: Minimum Value
!
subroutine psb_smins(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -355,7 +355,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -411,11 +411,11 @@ contains
end subroutine psb_smins
subroutine psb_sminv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -429,7 +429,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -488,11 +488,11 @@ contains
end subroutine psb_sminv
subroutine psb_sminm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -506,7 +506,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -571,11 +571,11 @@ contains
!
! !!!!!!!!!!!!
subroutine psb_s_nrm2s(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -589,7 +589,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -648,11 +648,11 @@ contains
end subroutine psb_s_nrm2s
subroutine psb_s_nrm2v(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -666,7 +666,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -729,11 +729,11 @@ contains
! gather
!
subroutine psb_sgather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -747,7 +747,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -797,11 +797,11 @@ contains
end subroutine psb_sgather_s
subroutine psb_sgather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -815,7 +815,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -865,11 +865,11 @@ contains
end subroutine psb_sgather_v
subroutine psb_sgatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -885,7 +885,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -974,11 +974,11 @@ contains
!
subroutine psb_ssums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -992,7 +992,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1050,11 +1050,11 @@ contains
end subroutine psb_ssums
subroutine psb_ssumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1068,7 +1068,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1127,11 +1127,11 @@ contains
end subroutine psb_ssumv
subroutine psb_ssumm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1145,7 +1145,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1208,11 +1208,11 @@ contains
!
subroutine psb_samxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1226,7 +1226,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1285,11 +1285,11 @@ contains
end subroutine psb_samxs
subroutine psb_samxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1303,7 +1303,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1362,11 +1362,11 @@ contains
end subroutine psb_samxv
subroutine psb_samxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1380,7 +1380,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1442,11 +1442,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_samns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1460,7 +1460,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1519,11 +1519,11 @@ contains
end subroutine psb_samns
subroutine psb_samnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1537,7 +1537,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1596,11 +1596,11 @@ contains
end subroutine psb_samnv
subroutine psb_samnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1614,7 +1614,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1677,11 +1677,11 @@ contains
! BCAST Broadcast
!
subroutine psb_sbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1696,7 +1696,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1732,11 +1732,11 @@ contains
end subroutine psb_sbcasts
subroutine psb_sbcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1750,7 +1750,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1787,11 +1787,11 @@ contains
end subroutine psb_sbcastv
subroutine psb_sbcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1805,7 +1805,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1849,11 +1849,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_sscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1867,7 +1867,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1900,11 +1900,11 @@ contains
end subroutine psb_sscan_sums
subroutine psb_sexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1919,7 +1919,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1954,11 +1954,11 @@ contains
end subroutine psb_sexscan_sums
subroutine psb_sscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1972,7 +1972,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
real(psb_spk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -2005,11 +2005,11 @@ contains
end subroutine psb_sscan_sumv
subroutine psb_sexscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -2024,7 +2024,7 @@ contains
logical :: collective_start, collective_end, collective_sync
real(psb_spk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -2097,17 +2097,17 @@ contains
subroutine psb_s_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
real(psb_spk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2134,14 +2134,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2154,14 +2154,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -2180,17 +2180,17 @@ contains
subroutine psb_s_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_spk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
real(psb_spk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
real(psb_spk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -2217,14 +2217,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -2237,14 +2237,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_r_spk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_s_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_s_p2p_mod
contains
subroutine psb_ssnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
real(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_ssndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
real(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_ssndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_ssndm
subroutine psb_srcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_srcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
real(psb_spk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_r_spk_,src,psb_real_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_srcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

162
base/modules/penv/psi_z_collective_mod.F90
Unescape Escape View File

@ -89,11 +89,11 @@ contains
! gather
!
subroutine psb_zgather_s(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -107,7 +107,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(1) = dat
#else
call psb_info(ctxt,iam,np)
@ -157,11 +157,11 @@ contains
end subroutine psb_zgather_s
subroutine psb_zgather_v(ctxt,dat,resv,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -175,7 +175,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -225,11 +225,11 @@ contains
end subroutine psb_zgather_v
subroutine psb_zgatherv_v(ctxt,dat,resv,szs,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -245,7 +245,7 @@ contains
integer(psb_mpk_), allocatable :: displs(:)
logical :: collective_start, collective_end, collective_sync
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
resv(:) = dat(:)
#else
call psb_info(ctxt,iam,np)
@ -334,11 +334,11 @@ contains
!
subroutine psb_zsums(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -352,7 +352,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -410,11 +410,11 @@ contains
end subroutine psb_zsums
subroutine psb_zsumv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -428,7 +428,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -487,11 +487,11 @@ contains
end subroutine psb_zsumv
subroutine psb_zsumm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -505,7 +505,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -568,11 +568,11 @@ contains
!
subroutine psb_zamxs(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -586,7 +586,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -645,11 +645,11 @@ contains
end subroutine psb_zamxs
subroutine psb_zamxv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -663,7 +663,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -722,11 +722,11 @@ contains
end subroutine psb_zamxv
subroutine psb_zamxm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -740,7 +740,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -802,11 +802,11 @@ contains
! AMN: Minimum Absolute Value
!
subroutine psb_zamns(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -820,7 +820,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -879,11 +879,11 @@ contains
end subroutine psb_zamns
subroutine psb_zamnv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -897,7 +897,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -956,11 +956,11 @@ contains
end subroutine psb_zamnv
subroutine psb_zamnm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -974,7 +974,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1037,11 +1037,11 @@ contains
! BCAST Broadcast
!
subroutine psb_zbcasts(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1056,7 +1056,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1092,11 +1092,11 @@ contains
end subroutine psb_zbcasts
subroutine psb_zbcastv(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1110,7 +1110,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
if (present(root)) then
@ -1147,11 +1147,11 @@ contains
end subroutine psb_zbcastv
subroutine psb_zbcastm(ctxt,dat,root,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1165,7 +1165,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
@ -1209,11 +1209,11 @@ contains
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psb_zscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1227,7 +1227,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1260,11 +1260,11 @@ contains
end subroutine psb_zscan_sums
subroutine psb_zexscan_sums(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1279,7 +1279,7 @@ contains
logical :: collective_start, collective_end, collective_sync
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1314,11 +1314,11 @@ contains
end subroutine psb_zexscan_sums
subroutine psb_zscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1332,7 +1332,7 @@ contains
integer(psb_mpk_) :: status(mpi_status_size)
logical :: collective_start, collective_end, collective_sync
complex(psb_dpk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1365,11 +1365,11 @@ contains
end subroutine psb_zscan_sumv
subroutine psb_zexscan_sumv(ctxt,dat,mode,request)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -1384,7 +1384,7 @@ contains
logical :: collective_start, collective_end, collective_sync
complex(psb_dpk_), allocatable :: dat_(:)
#if !defined(SERIAL_MPI)
#if !defined(PSB_SERIAL_MPI)
call psb_info(ctxt,iam,np)
icomm = psb_get_mpi_comm(ctxt)
if (present(mode)) then
@ -1457,17 +1457,17 @@ contains
subroutine psb_z_m_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
complex(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:)
complex(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1494,14 +1494,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1514,14 +1514,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_mpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if
@ -1540,17 +1540,17 @@ contains
subroutine psb_z_e_simple_triad_a2av(valsnd,iasnd,jasnd,sdsz,bsdindx,&
& valrcv,iarcv,jarcv,rvsz,brvindx,ctxt,info)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
complex(psb_dpk_), intent(in), target :: valsnd(:)
integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:)
complex(psb_dpk_), intent(out), target :: valrcv(:)
integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:)
complex(psb_dpk_), intent(in) :: valsnd(:)
integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:)
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) :: ctxt
integer(psb_ipk_), intent(out) :: info
@ -1577,14 +1577,14 @@ contains
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,&
call mpi_irecv(valrcv(idx+1:idx+sz),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,1),iret)
p2ptag = psb_int_swap_tag
call mpi_irecv((iarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(iarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,2),iret)
call mpi_irecv((jarcv(idx+1:idx+sz)),sz,&
call mpi_irecv(jarcv(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,rvhd(ip+1,3),iret)
end if
@ -1597,14 +1597,14 @@ contains
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,&
call mpi_send(valsnd(idx+1:idx+sz),sz,&
& psb_mpi_c_dpk_,prcid(ip+1),&
& p2ptag, icomm,iret)
p2ptag = psb_int_swap_tag
call mpi_send((iasnd(idx+1:idx+sz)),sz,&
call mpi_send(iasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
call mpi_send((jasnd(idx+1:idx+sz)),sz,&
call mpi_send(jasnd(idx+1:idx+sz),sz,&
& psb_mpi_epk_,prcid(ip+1),&
& p2ptag, icomm,iret)
end if

36
base/modules/penv/psi_z_p2p_mod.F90
Unescape Escape View File

@ -44,11 +44,11 @@ module psi_z_p2p_mod
contains
subroutine psb_zsnds(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -56,7 +56,7 @@ contains
integer(psb_mpk_), intent(in) :: dst
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
@ -67,11 +67,11 @@ contains
subroutine psb_zsndv(ctxt,dat,dst)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -80,7 +80,7 @@ contains
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
@ -91,11 +91,11 @@ contains
subroutine psb_zsndm(ctxt,dat,dst,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -106,7 +106,7 @@ contains
integer(psb_ipk_) :: i,j,k,m_,n_
integer(psb_mpk_) :: info
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
if (present(m)) then
m_ = m
@ -127,11 +127,11 @@ contains
end subroutine psb_zsndm
subroutine psb_zrcvs(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -139,7 +139,7 @@ contains
integer(psb_mpk_), intent(in) :: src
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! do nothing
#else
icomm = psb_get_mpi_comm(ctxt)
@ -150,11 +150,11 @@ contains
subroutine psb_zrcvv(ctxt,dat,src)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -163,7 +163,7 @@ contains
complex(psb_dpk_), allocatable :: dat_(:)
integer(psb_mpk_) :: info, icomm
integer(psb_mpk_) :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
#else
icomm = psb_get_mpi_comm(ctxt)
call mpi_recv(dat,size(dat),psb_mpi_c_dpk_,src,psb_dcomplex_tag,icomm,status,info)
@ -174,11 +174,11 @@ contains
subroutine psb_zrcvm(ctxt,dat,src,m)
#ifdef MPI_MOD
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
@ -189,7 +189,7 @@ contains
integer(psb_mpk_) :: info ,m_,n_, ld, mp_rcv_type
integer(psb_mpk_) :: i,j,k
integer(psb_mpk_) :: status(mpi_status_size), icomm
#if defined(SERIAL_MPI)
#if defined(PSB_SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then

6
base/modules/psb_cbind_const_mod.F90
Unescape Escape View File

@ -35,13 +35,13 @@ module psb_cbind_const_mod
use psb_const_mod
integer, parameter :: psb_c_mpk_ = c_int32_t
#if defined(IPK4) && defined(LPK4)
#if defined(PSB_IPK4) && defined(PSB_LPK4)
integer, parameter :: psb_c_ipk_ = c_int32_t
integer, parameter :: psb_c_lpk_ = c_int32_t
#elif defined(IPK4) && defined(LPK8)
#elif defined(PSB_IPK4) && defined(PSB_LPK8)
integer, parameter :: psb_c_ipk_ = c_int32_t
integer, parameter :: psb_c_lpk_ = c_int64_t
#elif defined(IPK8) && defined(LPK8)
#elif defined(PSB_IPK8) && defined(PSB_LPK8)
integer, parameter :: psb_c_ipk_ = c_int64_t
integer, parameter :: psb_c_lpk_ = c_int64_t
#else

41
base/modules/psb_config.h.in
Unescape Escape View File

@ -1,24 +1,15 @@
#ifndef PSB_CONFIG_H
#define PSB_CONFIG_H
#include <stdint.h>
#ifdef __cplusplus
#include <complex>
#else
#include <math.h>
#include <complex.h>
#endif
#define PSB_ERR_ERROR -1
#define PSB_ERR_SUCCESS 0
@CSERIALMPI@
@IPKDEF@
@LPKDEF@
@PSB_IPKDEF@
@PSB_LPKDEF@
@CHAVEOPENMP@
@CHAVE_OPENMP@
@CHAVEMETIS@
@CINTMETIS@
@ -35,30 +26,4 @@
typedef int32_t psb_m_t;
#if defined(IPK4) && defined(LPK4)
typedef int32_t psb_i_t;
typedef int32_t psb_l_t;
#elif defined(IPK4) && defined(LPK8)
typedef int32_t psb_i_t;
typedef int64_t psb_l_t;
#elif defined(IPK8) && defined(LPK8)
typedef int64_t psb_i_t;
typedef int64_t psb_l_t;
#else
#endif
typedef int64_t psb_e_t;
typedef float psb_s_t;
typedef double psb_d_t;
#ifdef __cplusplus
typedef std::complex<float> psb_c_t;
typedef std::complex<double> psb_z_t;
#else
typedef float complex psb_c_t;
typedef double complex psb_z_t;
#endif
#endif

22
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -70,29 +70,29 @@ module psb_const_mod
#endif
! Now for the choices:
! IPK = integer kind for "local" indices and sizes.
! PSB_IPK = integer kind for "local" indices and sizes.
! Can be 4 or 8 bytes.
! LPK = integer kind for "global" indices and sizes.
! PSB_LPK = integer kind for "global" indices and sizes.
! Can be 4 or 8 bytes.
! Size must be >= size of IPK
! Size must be >= size of PSB_IPK
!
! Additional rules:
! 1. MPI related stuff is always MPK
! 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
! 3. INFO, ERR_ACT, IERR etc are always PSB_IPK
! 4. For the array version of things, where it makes sense
! e.g. realloc, snd/receive, define as MPK,EPK and the
! compiler will later pick up the correct version according
! to what IPK/LPK are mapped onto.
! to what PSB_IPK/PSB_LPK are mapped onto.
!
#if defined(IPK4) && defined(LPK4)
#if defined(PSB_IPK4) && defined(PSB_LPK4)
integer, parameter :: psb_ipk_ = psb_mpk_
integer, parameter :: psb_lpk_ = psb_mpk_
#elif defined(IPK4) && defined(LPK8)
#elif defined(PSB_IPK4) && defined(PSB_LPK8)
integer, parameter :: psb_ipk_ = psb_mpk_
integer, parameter :: psb_lpk_ = psb_epk_
#elif defined(IPK8) && defined(LPK8)
#elif defined(PSB_IPK8) && defined(PSB_LPK8)
integer, parameter :: psb_ipk_ = psb_epk_
integer, parameter :: psb_lpk_ = psb_epk_
#else
@ -107,13 +107,13 @@ module psb_const_mod
integer(psb_epk_), save :: psb_sizeof_mp = 4
integer(psb_epk_), save :: psb_sizeof_ep = 8
#if defined(IPK4) && defined(LPK4)
#if defined(PSB_IPK4) && defined(PSB_LPK4)
integer(psb_epk_), save :: psb_sizeof_ip = 4
integer(psb_epk_), save :: psb_sizeof_lp = 4
#elif defined(IPK4) && defined(LPK8)
#elif defined(PSB_IPK4) && defined(PSB_LPK8)
integer(psb_epk_), save :: psb_sizeof_ip = 4
integer(psb_epk_), save :: psb_sizeof_lp = 8
#elif defined(IPK8) && defined(LPK8)
#elif defined(PSB_IPK8) && defined(PSB_LPK8)
integer(psb_epk_), save :: psb_sizeof_ip = 8
integer(psb_epk_), save :: psb_sizeof_lp = 8
#else

8
base/modules/psb_error_impl.F90
Unescape Escape View File

@ -9,7 +9,7 @@ subroutine psb_errcomm_i(ctxt, err)
end subroutine psb_errcomm_i
#if defined(IPK8)
#if defined(PSB_IPK8)
subroutine psb_errcomm_m(ctxt, err)
use psb_error_mod, psb_protect_name => psb_errcomm
@ -105,7 +105,7 @@ subroutine psb_serror()
end do
end if
end if
#if defined(HAVE_FLUSH_STMT)
#if defined(PSB_HAVE_FLUSH_STMT)
flush(psb_err_unit)
#endif
@ -142,7 +142,7 @@ subroutine psb_perror(ctxt,abrt)
call psb_errmsg(psb_err_unit,err_c, r_name, e_e_d, a_e_d,iam)
! write(psb_err_unit,'(50("="))')
end do
#if defined(HAVE_FLUSH_STMT)
#if defined(PSB_HAVE_FLUSH_STMT)
flush(psb_err_unit)
#endif
@ -155,7 +155,7 @@ subroutine psb_perror(ctxt,abrt)
do while (psb_get_numerr() > 0)
call psb_errpop(err_c, r_name, e_e_d, a_e_d)
end do
#if defined(HAVE_FLUSH_STMT)
#if defined(PSB_HAVE_FLUSH_STMT)
flush(psb_err_unit)
#endif

2
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -100,7 +100,7 @@ module psb_error_mod
end interface
interface psb_errcomm
#if defined(IPK8)
#if defined(PSB_IPK8)
subroutine psb_errcomm_m(ctxt, err)
import :: psb_ipk_, psb_mpk_, psb_ctxt_type
type(pxb_ctxt_type), intent(in) :: ctxt

5
base/modules/psb_fakempi.h
Unescape Escape View File

@ -1,6 +1,7 @@
#ifndef PSB_INTERNALS_H
#define PSB_INTERNALS_H
#ifndef PSB_FAKEMPI_H
#define PSB_FAKEMPI_H
#include "psb_config.h"
#include "psb_types.h"
#define MPI_INTEGER 1
#define MPI_INTEGER8 2

38
base/modules/psb_types.h
Unescape Escape View File

@ -0,0 +1,38 @@
#ifndef PSB_TYPES_H
#define PSB_TYPES_H
#include <stdint.h>
#ifdef __cplusplus
#include <complex>
#else
#include <math.h>
#include <complex.h>
#endif
typedef int32_t psb_m_t;
#if defined(PSB_IPK4) && defined(PSB_LPK4)
typedef int32_t psb_i_t;
typedef int32_t psb_l_t;
#elif defined(PSB_IPK4) && defined(PSB_LPK8)
typedef int32_t psb_i_t;
typedef int64_t psb_l_t;
#elif defined(PSB_IPK8) && defined(PSB_LPK8)
typedef int64_t psb_i_t;
typedef int64_t psb_l_t;
#else
#endif
typedef int64_t psb_e_t;
typedef float psb_s_t;
typedef double psb_d_t;
#ifdef __cplusplus
typedef std::complex<float> psb_c_t;
typedef std::complex<double> psb_z_t;
#else
typedef float complex psb_c_t;
typedef double complex psb_z_t;
#endif
#endif

10
base/modules/psblas/psb_c_psblas_mod.F90
Unescape Escape View File

@ -188,7 +188,7 @@ module psb_c_psblas_mod
end function psb_camax_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_camax, psb_camaxv, psb_camax_vect
end interface
@ -272,7 +272,7 @@ module psb_c_psblas_mod
end subroutine psb_cmasum
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_casum, psb_casumv, psb_casum_vect
end interface
@ -335,7 +335,7 @@ module psb_c_psblas_mod
end function psb_cnrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_cnrm2, psb_cnrm2v, psb_cnrm2_vect, psb_cnrm2_weight_vect, psb_cnrm2_weightmask_vect
end interface
@ -366,7 +366,7 @@ module psb_c_psblas_mod
end function psb_cnrmi
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_cnrmi
end interface
@ -384,7 +384,7 @@ module psb_c_psblas_mod
end function psb_cspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_cspnrm1
end interface

10
base/modules/psblas/psb_d_psblas_mod.F90
Unescape Escape View File

@ -188,7 +188,7 @@ module psb_d_psblas_mod
end function psb_damax_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_damax, psb_damaxv, psb_damax_vect
end interface
@ -283,7 +283,7 @@ module psb_d_psblas_mod
end subroutine psb_dmasum
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_dasum, psb_dasumv, psb_dasum_vect
end interface
@ -346,7 +346,7 @@ module psb_d_psblas_mod
end function psb_dnrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_dnrm2, psb_dnrm2v, psb_dnrm2_vect, psb_dnrm2_weight_vect, psb_dnrm2_weightmask_vect
end interface
@ -377,7 +377,7 @@ module psb_d_psblas_mod
end function psb_dnrmi
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_dnrmi
end interface
@ -395,7 +395,7 @@ module psb_d_psblas_mod
end function psb_dspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_dspnrm1
end interface

10
base/modules/psblas/psb_s_psblas_mod.F90
Unescape Escape View File

@ -188,7 +188,7 @@ module psb_s_psblas_mod
end function psb_samax_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_samax, psb_samaxv, psb_samax_vect
end interface
@ -283,7 +283,7 @@ module psb_s_psblas_mod
end subroutine psb_smasum
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_sasum, psb_sasumv, psb_sasum_vect
end interface
@ -346,7 +346,7 @@ module psb_s_psblas_mod
end function psb_snrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_snrm2, psb_snrm2v, psb_snrm2_vect, psb_snrm2_weight_vect, psb_snrm2_weightmask_vect
end interface
@ -377,7 +377,7 @@ module psb_s_psblas_mod
end function psb_snrmi
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_snrmi
end interface
@ -395,7 +395,7 @@ module psb_s_psblas_mod
end function psb_sspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_sspnrm1
end interface

10
base/modules/psblas/psb_z_psblas_mod.F90
Unescape Escape View File

@ -188,7 +188,7 @@ module psb_z_psblas_mod
end function psb_zamax_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrmi
procedure psb_zamax, psb_zamaxv, psb_zamax_vect
end interface
@ -272,7 +272,7 @@ module psb_z_psblas_mod
end subroutine psb_zmasum
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_genrm1
procedure psb_zasum, psb_zasumv, psb_zasum_vect
end interface
@ -335,7 +335,7 @@ module psb_z_psblas_mod
end function psb_znrm2_weightmask_vect
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm2
procedure psb_znrm2, psb_znrm2v, psb_znrm2_vect, psb_znrm2_weight_vect, psb_znrm2_weightmask_vect
end interface
@ -366,7 +366,7 @@ module psb_z_psblas_mod
end function psb_znrmi
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_normi
procedure psb_znrmi
end interface
@ -384,7 +384,7 @@ module psb_z_psblas_mod
end function psb_zspnrm1
end interface
#if ! defined(HAVE_BUGGY_GENERICS)
#if ! defined(PSB_HAVE_BUGGY_GENERICS)
interface psb_norm1
procedure psb_zspnrm1
end interface

10
base/modules/serial/psb_base_mat_mod.F90
Unescape Escape View File

@ -61,7 +61,7 @@
!
! We are also introducing the type psb_lbase_sparse_mat.
! The basic difference is in the type
! of the indices, which are PSB_LPK_ so that the entries
! of the indices, which are PSB_PSB_LPK_ so that the entries
! are guaranteed to be able to contain global indices.
! This type only supports data handling and preprocessing, it is
! not supposed to be used for computations.
@ -80,7 +80,7 @@ module psb_base_mat_mod
integer(psb_ipk_), parameter :: spspmm_serial_rb_tree = 3
integer(psb_ipk_), parameter :: spspmm_omp_rb_tree = 4
integer(psb_ipk_), parameter :: spspmm_omp_two_pass = 5
#if defined(OPENMP)
#if defined(PSB_OPENMP)
integer(psb_ipk_), save :: spspmm_impl = spspmm_omp_gustavson
#else
integer(psb_ipk_), save :: spspmm_impl = spspmm_serial
@ -564,7 +564,7 @@ module psb_base_mat_mod
! == = =================================
procedure, pass(a) :: set_lnrows => psb_lbase_set_lnrows
procedure, pass(a) :: set_lncols => psb_lbase_set_lncols
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: set_inrows => psb_lbase_set_inrows
procedure, pass(a) :: set_incols => psb_lbase_set_incols
generic, public :: set_nrows => set_lnrows, set_inrows
@ -601,7 +601,7 @@ module psb_base_mat_mod
procedure, pass(a) :: reinit => psb_lbase_reinit
procedure, pass(a) :: allocate_mnnz => psb_lbase_allocate_mnnz
procedure, pass(a) :: reallocate_nz => psb_lbase_reallocate_nz
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: allocate_imnnz => psb_lbase_allocate_imnnz
procedure, pass(a) :: reallocate_inz => psb_lbase_reallocate_inz
generic, public :: allocate => allocate_mnnz, allocate_imnnz
@ -1433,7 +1433,7 @@ contains
a%n = n
end subroutine psb_lbase_set_lncols
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_lbase_allocate_imnnz(m,n,a,nz)
implicit none
integer(psb_ipk_), intent(in) :: m,n

8
base/modules/serial/psb_c_base_mat_mod.F90
Unescape Escape View File

@ -416,7 +416,7 @@ module psb_c_base_mat_mod
!
! This is COO specific
!
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: iset_nzeros => lc_coo_iset_nzeros
procedure, pass(a) :: lset_nzeros => lc_coo_lset_nzeros
generic, public :: set_nzeros => iset_nzeros, lset_nzeros
@ -439,7 +439,7 @@ module psb_c_base_mat_mod
private :: lc_coo_get_nzeros, lc_coo_iset_nzeros, &
& lc_coo_get_fmt, lc_coo_free, lc_coo_sizeof, &
& lc_coo_transp_1mat, lc_coo_transc_1mat
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
private :: lc_coo_lset_nzeros
#endif
@ -3499,7 +3499,7 @@ module psb_c_base_mat_mod
end subroutine psb_lc_coo_clean_negidx
end interface
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
!
!> Funtion: coo_clean_negidx_inner
!! \brief Take out any entries with negative row or column index
@ -4323,7 +4323,7 @@ contains
end subroutine lc_coo_iset_nzeros
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine lc_coo_lset_nzeros(nz,a)
implicit none
integer(psb_lpk_), intent(in) :: nz

16
base/modules/serial/psb_c_base_vect_mod.F90
Unescape Escape View File

@ -276,7 +276,7 @@ contains
call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld')
return
end if
#if defined (OPENMP)
#if defined (PSB_OPENMP)
!$omp parallel do private(i)
do i = 1, size(this)
x%v(i) = this(i)
@ -841,7 +841,7 @@ contains
if (present(last)) last_ = min(last,last_)
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i = first_, last_
x%v(i) = val
@ -879,7 +879,7 @@ contains
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i = first_, last_
x%v(i) = val(i-first_+1)
@ -928,7 +928,7 @@ contains
if (allocated(x%v)) then
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i=1, size(x%v)
x%v(i) = abs(x%v(i))
@ -1735,7 +1735,7 @@ contains
integer(psb_ipk_) :: i
if (allocated(x%v)) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i=1,size(x%v)
x%v(i) = alpha*x%v(i)
@ -1779,7 +1779,7 @@ contains
integer(psb_ipk_) :: i
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
res = szero
!$omp parallel do private(i) reduction(max: res)
do i=1, n
@ -1804,7 +1804,7 @@ contains
integer(psb_ipk_) :: i
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
res=szero
!$omp parallel do private(i) reduction(+: res)
do i= 1, size(x%v)
@ -2019,7 +2019,7 @@ contains
integer(psb_ipk_) :: i, n
if (z%is_dev()) call z%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
n = size(x)
!$omp parallel do private(i)
do i = 1, n

16
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -71,7 +71,7 @@
!
! We are also introducing the type psb_lcspmat_type.
! The basic difference with psb_cspmat_type is in the type
! of the indices, which are PSB_LPK_ so that the entries
! of the indices, which are PSB_PSB_LPK_ so that the entries
! are guaranteed to be able to contain global indices.
! This type only supports data handling and preprocessing, it is
! not supposed to be used for computations.
@ -145,7 +145,7 @@ module psb_c_mat_mod
procedure, pass(a) :: csgetrow => psb_c_csgetrow
procedure, pass(a) :: csgetblk => psb_c_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: lcsgetptn => psb_c_lcsgetptn
procedure, pass(a) :: lcsgetrow => psb_c_lcsgetrow
generic, public :: csget => lcsgetptn, lcsgetrow
@ -311,7 +311,7 @@ module psb_c_mat_mod
! Setters
procedure, pass(a) :: set_lnrows => psb_lc_set_lnrows
procedure, pass(a) :: set_lncols => psb_lc_set_lncols
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: set_inrows => psb_lc_set_inrows
procedure, pass(a) :: set_incols => psb_lc_set_incols
generic, public :: set_nrows => set_inrows, set_lnrows
@ -346,7 +346,7 @@ module psb_c_mat_mod
procedure, pass(a) :: csgetrow => psb_lc_csgetrow
procedure, pass(a) :: csgetblk => psb_lc_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
!!$ procedure, pass(a) :: icsgetptn => psb_lc_icsgetptn
!!$ procedure, pass(a) :: icsgetrow => psb_lc_icsgetrow
!!$ generic, public :: csget => icsgetptn, icsgetrow
@ -1270,7 +1270,7 @@ module psb_c_mat_mod
class(psb_lcspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: m
end subroutine psb_lc_set_lnrows
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_lc_set_inrows(m,a)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
class(psb_lcspmat_type), intent(inout) :: a
@ -1285,7 +1285,7 @@ module psb_c_mat_mod
class(psb_lcspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: n
end subroutine psb_lc_set_lncols
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_lc_set_incols(n,a)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
class(psb_lcspmat_type), intent(inout) :: a
@ -2410,7 +2410,7 @@ contains
end subroutine psb_c_clean_zeros
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_c_lcsgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
implicit none
@ -2929,7 +2929,7 @@ contains
end subroutine psb_lc_clean_zeros
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
!!$ subroutine psb_lc_icsgetptn(imin,imax,a,nz,ia,ja,info,&
!!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
!!$ implicit none

8
base/modules/serial/psb_d_base_mat_mod.F90
Unescape Escape View File

@ -416,7 +416,7 @@ module psb_d_base_mat_mod
!
! This is COO specific
!
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: iset_nzeros => ld_coo_iset_nzeros
procedure, pass(a) :: lset_nzeros => ld_coo_lset_nzeros
generic, public :: set_nzeros => iset_nzeros, lset_nzeros
@ -439,7 +439,7 @@ module psb_d_base_mat_mod
private :: ld_coo_get_nzeros, ld_coo_iset_nzeros, &
& ld_coo_get_fmt, ld_coo_free, ld_coo_sizeof, &
& ld_coo_transp_1mat, ld_coo_transc_1mat
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
private :: ld_coo_lset_nzeros
#endif
@ -3499,7 +3499,7 @@ module psb_d_base_mat_mod
end subroutine psb_ld_coo_clean_negidx
end interface
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
!
!> Funtion: coo_clean_negidx_inner
!! \brief Take out any entries with negative row or column index
@ -4323,7 +4323,7 @@ contains
end subroutine ld_coo_iset_nzeros
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine ld_coo_lset_nzeros(nz,a)
implicit none
integer(psb_lpk_), intent(in) :: nz

18
base/modules/serial/psb_d_base_vect_mod.F90
Unescape Escape View File

@ -283,7 +283,7 @@ contains
call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld')
return
end if
#if defined (OPENMP)
#if defined (PSB_OPENMP)
!$omp parallel do private(i)
do i = 1, size(this)
x%v(i) = this(i)
@ -848,7 +848,7 @@ contains
if (present(last)) last_ = min(last,last_)
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i = first_, last_
x%v(i) = val
@ -886,7 +886,7 @@ contains
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i = first_, last_
x%v(i) = val(i-first_+1)
@ -935,7 +935,7 @@ contains
if (allocated(x%v)) then
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i=1, size(x%v)
x%v(i) = abs(x%v(i))
@ -1742,7 +1742,7 @@ contains
integer(psb_ipk_) :: i
if (allocated(x%v)) then
#if defined(OPENMP)
#if defined(PSB_OPENMP)
!$omp parallel do private(i)
do i=1,size(x%v)
x%v(i) = alpha*x%v(i)
@ -1786,7 +1786,7 @@ contains
integer(psb_ipk_) :: i
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
res = dzero
!$omp parallel do private(i) reduction(max: res)
do i=1, n
@ -1810,7 +1810,7 @@ contains
integer(psb_ipk_) :: i
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
res = HUGE(done)
!$omp parallel do private(i) reduction(min: res)
do i=1, n
@ -1891,7 +1891,7 @@ contains
integer(psb_ipk_) :: i
if (x%is_dev()) call x%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
res=dzero
!$omp parallel do private(i) reduction(+: res)
do i= 1, size(x%v)
@ -2198,7 +2198,7 @@ contains
integer(psb_ipk_) :: i, n
if (z%is_dev()) call z%sync()
#if defined(OPENMP)
#if defined(PSB_OPENMP)
n = size(x)
!$omp parallel do private(i)
do i = 1, n

16
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -71,7 +71,7 @@
!
! We are also introducing the type psb_ldspmat_type.
! The basic difference with psb_dspmat_type is in the type
! of the indices, which are PSB_LPK_ so that the entries
! of the indices, which are PSB_PSB_LPK_ so that the entries
! are guaranteed to be able to contain global indices.
! This type only supports data handling and preprocessing, it is
! not supposed to be used for computations.
@ -145,7 +145,7 @@ module psb_d_mat_mod
procedure, pass(a) :: csgetrow => psb_d_csgetrow
procedure, pass(a) :: csgetblk => psb_d_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: lcsgetptn => psb_d_lcsgetptn
procedure, pass(a) :: lcsgetrow => psb_d_lcsgetrow
generic, public :: csget => lcsgetptn, lcsgetrow
@ -311,7 +311,7 @@ module psb_d_mat_mod
! Setters
procedure, pass(a) :: set_lnrows => psb_ld_set_lnrows
procedure, pass(a) :: set_lncols => psb_ld_set_lncols
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
procedure, pass(a) :: set_inrows => psb_ld_set_inrows
procedure, pass(a) :: set_incols => psb_ld_set_incols
generic, public :: set_nrows => set_inrows, set_lnrows
@ -346,7 +346,7 @@ module psb_d_mat_mod
procedure, pass(a) :: csgetrow => psb_ld_csgetrow
procedure, pass(a) :: csgetblk => psb_ld_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
!!$ procedure, pass(a) :: icsgetptn => psb_ld_icsgetptn
!!$ procedure, pass(a) :: icsgetrow => psb_ld_icsgetrow
!!$ generic, public :: csget => icsgetptn, icsgetrow
@ -1270,7 +1270,7 @@ module psb_d_mat_mod
class(psb_ldspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: m
end subroutine psb_ld_set_lnrows
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_ld_set_inrows(m,a)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
class(psb_ldspmat_type), intent(inout) :: a
@ -1285,7 +1285,7 @@ module psb_d_mat_mod
class(psb_ldspmat_type), intent(inout) :: a
integer(psb_lpk_), intent(in) :: n
end subroutine psb_ld_set_lncols
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_ld_set_incols(n,a)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
class(psb_ldspmat_type), intent(inout) :: a
@ -2410,7 +2410,7 @@ contains
end subroutine psb_d_clean_zeros
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
subroutine psb_d_lcsgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
implicit none
@ -2929,7 +2929,7 @@ contains
end subroutine psb_ld_clean_zeros
#if defined(IPK4) && defined(LPK8)
#if defined(PSB_IPK4) && defined(PSB_LPK8)
!!$ subroutine psb_ld_icsgetptn(imin,imax,a,nz,ia,ja,info,&
!!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
!!$ implicit none

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save