mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 10:52:08 +00:00
Make.inc.in README base/comm/Makefile base/comm/psb_cgather.f90 base/comm/psb_chalo.f90 base/comm/psb_covrl.f90 base/comm/psb_sgather.f90 base/comm/psb_shalo.f90 base/comm/psb_sovrl.f90 base/internals/Makefile base/internals/psi_cswapdata.F90 base/internals/psi_cswaptran.F90 base/internals/psi_sswapdata.F90 base/internals/psi_sswaptran.F90 base/modules/Makefile base/modules/psb_blacs_mod.f90 base/modules/psb_comm_mod.f90 base/modules/psb_const_mod.f90 base/modules/psb_error_mod.F90 base/modules/psb_inter_desc_type.f90 base/modules/psb_penv_mod.F90 base/modules/psb_psblas_mod.f90 base/modules/psb_realloc_mod.F90 base/modules/psb_serial_mod.f90 base/modules/psb_sort_mod.f90 base/modules/psb_spmat_type.f90 base/modules/psb_spsb_mod.f90 base/modules/psb_string_mod.f90 base/modules/psb_tools_mod.f90 base/modules/psi_mod.f90 base/modules/psi_serial_mod.f90 base/psblas/Makefile base/psblas/psb_camax.f90 base/psblas/psb_casum.f90 base/psblas/psb_caxpby.f90 base/psblas/psb_cdot.f90 base/psblas/psb_cnrm2.f90 base/psblas/psb_cnrmi.f90 base/psblas/psb_cspmm.f90 base/psblas/psb_cspsm.f90 base/psblas/psb_dnrmi.f90 base/psblas/psb_samax.f90 base/psblas/psb_sasum.f90 base/psblas/psb_saxpby.f90 base/psblas/psb_sdot.f90 base/psblas/psb_snrm2.f90 base/psblas/psb_snrmi.f90 base/psblas/psb_sspmm.f90 base/psblas/psb_sspsm.f90 base/psblas/psb_sxdot.f90 base/psblas/psb_zaxpby.f90 base/psblas/psb_znrmi.f90 base/psblas/pstreecomb.F base/serial/Makefile base/serial/aux/Makefile base/serial/aux/cacmp_mod.f90 base/serial/aux/calcmp_mod.f90 base/serial/aux/calsr.f90 base/serial/aux/calsrx.f90 base/serial/aux/camsort_dw.f90 base/serial/aux/camsort_up.f90 base/serial/aux/camsr.f90 base/serial/aux/camsrx.f90 base/serial/aux/casr.f90 base/serial/aux/casrx.f90 base/serial/aux/clcmp_mod.f90 base/serial/aux/clsr.f90 base/serial/aux/clsrx.f90 base/serial/aux/sasr.f90 base/serial/aux/sasrx.f90 base/serial/aux/smsort_dw.f90 base/serial/aux/smsort_up.f90 base/serial/aux/smsr.f90 base/serial/aux/smsrx.f90 base/serial/aux/ssr.f90 base/serial/aux/ssrx.f90 base/serial/coo/Makefile base/serial/coo/ccoomm.f base/serial/coo/ccoomv.f base/serial/coo/ccoonrmi.f base/serial/coo/ccoorws.f base/serial/coo/ccoosm.f base/serial/coo/ccoosv.f base/serial/coo/dcoosm.f base/serial/coo/scoomm.f base/serial/coo/scoomv.f base/serial/coo/scoonrmi.f base/serial/coo/scoorws.f base/serial/coo/scoosm.f base/serial/coo/scoosv.f base/serial/coo/zcoosm.f base/serial/csr/Makefile base/serial/csr/ccrnrmi.f base/serial/csr/ccsrck.f base/serial/csr/ccsrmm.f base/serial/csr/ccsrrws.f base/serial/csr/ccsrsm.f base/serial/csr/csrmv.f base/serial/csr/csrsv.f base/serial/csr/dcsrck.f base/serial/csr/dcsrmm.f base/serial/csr/dcsrmv.f base/serial/csr/dcsrmv2.f base/serial/csr/dcsrmv3.f base/serial/csr/dcsrmv4.f base/serial/csr/dcsrrws.f base/serial/csr/dcsrsm.f base/serial/csr/dcsrsv.f base/serial/csr/scrnrmi.f base/serial/csr/scsrmm.f base/serial/csr/scsrmv.f base/serial/csr/scsrmv2.f base/serial/csr/scsrmv3.f base/serial/csr/scsrmv4.f base/serial/csr/scsrsm.f base/serial/csr/scsrsv.f base/serial/csr/zcrnrmi.f base/serial/csr/zcsrck.f base/serial/csr/zcsrmm.f base/serial/csr/zcsrrws.f base/serial/csr/zcsrsm.f base/serial/csr/zsrmv.f base/serial/csr/zsrsv.f base/serial/dp/Makefile base/serial/dp/ccoco.f base/serial/dp/ccocr.f base/serial/dp/ccrco.f base/serial/dp/ccrcr.f base/serial/dp/ccrjd.f base/serial/dp/cgind_tri.f base/serial/dp/cgindex.f base/serial/dp/reordvn.f base/serial/dp/scoco.f base/serial/dp/scocr.f base/serial/dp/scrco.f base/serial/dp/scrcr.f base/serial/dp/scrjd.f base/serial/dp/sgind_tri.f base/serial/dp/sgindex.f base/serial/f77/Makefile base/serial/f77/caxpby.f base/serial/f77/ccsmm.f base/serial/f77/ccsnmi.f base/serial/f77/ccsrws.f base/serial/f77/ccssm.f base/serial/f77/cgelp.f base/serial/f77/clpupd.f base/serial/f77/cswmm.f base/serial/f77/cswsm.f base/serial/f77/daxpby.f base/serial/f77/dcsmm.f base/serial/f77/dcsnmi.f base/serial/f77/dcsrp.f base/serial/f77/dcsrws.f base/serial/f77/dcssm.f base/serial/f77/dgelp.f base/serial/f77/dlpupd.f base/serial/f77/dswmm.f base/serial/f77/dswsm.f base/serial/f77/saxpby.f base/serial/f77/scsmm.f base/serial/f77/scsnmi.f base/serial/f77/scsrws.f base/serial/f77/scssm.f base/serial/f77/sgelp.f base/serial/f77/slpupd.f base/serial/f77/smmp.f base/serial/f77/sswmm.f base/serial/f77/sswsm.f base/serial/f77/zcsmm.f base/serial/f77/zcsnmi.f base/serial/f77/zcsrws.f base/serial/f77/zcssm.f base/serial/f77/zgelp.f base/serial/f77/zlpupd.f base/serial/f77/zswmm.f base/serial/f77/zswsm.f base/serial/jad/Makefile base/serial/jad/sjadmm.f base/serial/jad/sjadmv.f base/serial/jad/sjadmv2.f base/serial/jad/sjadmv3.f base/serial/jad/sjadmv4.f base/serial/jad/sjadnr.f base/serial/jad/sjadrws.f base/serial/jad/sjadsm.f base/serial/jad/sjadsv.f base/serial/jad/sjdnrmi.f base/serial/jad/sjdrws.f base/serial/psb_ccoins.f90 base/serial/psb_ccsmm.f90 base/serial/psb_ccsmv.f90 base/serial/psb_ccsnmi.f90 base/serial/psb_ccsprt.f90 base/serial/psb_ccssm.f90 base/serial/psb_ccssv.f90 base/serial/psb_cfixcoo.f90 base/serial/psb_cgelp.f90 base/serial/psb_cipcoo2csc.f90 base/serial/psb_cipcoo2csr.f90 base/serial/psb_cipcsr2coo.f90 base/serial/psb_cneigh.f90 base/serial/psb_cnumbmm.f90 base/serial/psb_crwextd.f90 base/serial/psb_cspclip.f90 base/serial/psb_cspcnv.f90 base/serial/psb_cspgetrow.f90 base/serial/psb_cspgtblk.f90 base/serial/psb_cspgtdiag.f90 base/serial/psb_cspscal.f90 base/serial/psb_csymbmm.f90 base/serial/psb_ctransc.f90 base/serial/psb_ctransp.f90 base/serial/psb_dcoins.f90 base/serial/psb_dspcnv.f90 base/serial/psb_getrow_mod.f90 base/serial/psb_regen_mod.f90 base/serial/psb_scoins.f90 base/serial/psb_scsmm.f90 base/serial/psb_scsmv.f90 base/serial/psb_scsnmi.f90 base/serial/psb_scsprt.f90 base/serial/psb_scssm.f90 base/serial/psb_scssv.f90 base/serial/psb_sfixcoo.f90 base/serial/psb_sgelp.f90 base/serial/psb_sipcoo2csc.f90 base/serial/psb_sipcoo2csr.f90 base/serial/psb_sipcsr2coo.f90 base/serial/psb_sneigh.f90 base/serial/psb_snumbmm.f90 base/serial/psb_srwextd.f90 base/serial/psb_sspclip.f90 base/serial/psb_sspcnv.f90 base/serial/psb_sspgetrow.f90 base/serial/psb_sspgtblk.f90 base/serial/psb_sspgtdiag.f90 base/serial/psb_sspscal.f90 base/serial/psb_ssymbmm.f90 base/serial/psb_stransp.f90 base/serial/psb_update_mod.f90 base/serial/psb_zcoins.f90 base/serial/psb_zcsnmi.f90 base/serial/psb_zspcnv.f90 base/tools/Makefile base/tools/psb_callc.f90 base/tools/psb_casb.f90 base/tools/psb_ccdbldext.F90 base/tools/psb_cfree.f90 base/tools/psb_cins.f90 base/tools/psb_cspalloc.f90 base/tools/psb_cspasb.f90 base/tools/psb_cspfree.f90 base/tools/psb_csphalo.F90 base/tools/psb_cspins.f90 base/tools/psb_csprn.f90 base/tools/psb_dspins.f90 base/tools/psb_sallc.f90 base/tools/psb_sasb.f90 base/tools/psb_scdbldext.F90 base/tools/psb_sfree.f90 base/tools/psb_sins.f90 base/tools/psb_sspalloc.f90 base/tools/psb_sspasb.f90 base/tools/psb_sspfree.f90 base/tools/psb_ssphalo.F90 base/tools/psb_sspins.f90 base/tools/psb_ssprn.f90 base/tools/psb_zspins.f90 config/acx_lapack.m4 configure.ac configure krylov/Makefile krylov/psb_cbicg.f90 krylov/psb_ccg.f90 krylov/psb_ccgs.f90 krylov/psb_ccgstab.f90 krylov/psb_ccgstabl.f90 krylov/psb_crgmres.f90 krylov/psb_dcg.F90 krylov/psb_dcg.f90 krylov/psb_krylov_mod.f90 krylov/psb_sbicg.f90 krylov/psb_scg.F90 krylov/psb_scgs.f90 krylov/psb_scgstab.F90 krylov/psb_scgstabl.f90 krylov/psb_srgmres.f90 krylov/psb_zcg.F90 krylov/psb_zcg.f90 prec/Makefile prec/psb_cbjac_aply.f90 prec/psb_cbjac_bld.f90 prec/psb_cdiagsc_bld.f90 prec/psb_cgprec_aply.f90 prec/psb_cilu_fct.f90 prec/psb_cprc_aply.f90 prec/psb_cprecbld.f90 prec/psb_cprecinit.f90 prec/psb_cprecset.f90 prec/psb_prec_mod.f90 prec/psb_prec_type.f90 prec/psb_sbjac_aply.f90 prec/psb_sbjac_bld.f90 prec/psb_sdiagsc_bld.f90 prec/psb_sgprec_aply.f90 prec/psb_silu_fct.f90 prec/psb_sprc_aply.f90 prec/psb_sprecbld.f90 prec/psb_sprecinit.f90 prec/psb_sprecset.f90 test/fileread/Makefile test/fileread/cf_sample.f90 test/fileread/df_sample.f90 test/fileread/getp.f90 test/fileread/runs/cfs.inp test/fileread/runs/sfs.inp test/fileread/sf_sample.f90 test/fileread/zf_sample.f90 test/pargen/Makefile test/pargen/ppde.f90 test/pargen/runs/ppde.inp test/pargen/spde.f90 util/psb_hbio_mod.f90 util/psb_mat_dist_mod.f90 util/psb_mmio_mod.f90 util/psb_read_mat_mod.f90 Merged the single precision branch.
4690 lines
116 KiB
Fortran
4690 lines
116 KiB
Fortran
module psb_blacs_mod
|
|
use psb_const_mod
|
|
|
|
interface gebs2d
|
|
module procedure igebs2ds, igebs2dv, igebs2dm,&
|
|
& dgebs2ds, dgebs2dv, dgebs2dm,&
|
|
& zgebs2ds, zgebs2dv, zgebs2dm,&
|
|
& sgebs2ds, sgebs2dv, sgebs2dm,&
|
|
& cgebs2ds, cgebs2dv, cgebs2dm
|
|
end interface
|
|
|
|
interface gebr2d
|
|
module procedure igebr2ds, igebr2dv, igebr2dm,&
|
|
& dgebr2ds, dgebr2dv, dgebr2dm,&
|
|
& zgebr2ds, zgebr2dv, zgebr2dm,&
|
|
& sgebr2ds, sgebr2dv, sgebr2dm,&
|
|
& cgebr2ds, cgebr2dv, cgebr2dm
|
|
|
|
end interface
|
|
|
|
interface gesd2d
|
|
module procedure igesd2ds, igesd2dv, igesd2dm,&
|
|
& dgesd2ds, dgesd2dv, dgesd2dm,&
|
|
& zgesd2ds, zgesd2dv, zgesd2dm,&
|
|
& sgesd2ds, sgesd2dv, sgesd2dm,&
|
|
& cgesd2ds, cgesd2dv, cgesd2dm
|
|
end interface
|
|
|
|
interface gerv2d
|
|
module procedure igerv2ds, igerv2dv, igerv2dm,&
|
|
& dgerv2ds, dgerv2dv, dgerv2dm,&
|
|
& zgerv2ds, zgerv2dv, zgerv2dm,&
|
|
& sgerv2ds, sgerv2dv, sgerv2dm,&
|
|
& cgerv2ds, cgerv2dv, cgerv2dm
|
|
end interface
|
|
|
|
interface gsum2d
|
|
module procedure igsum2ds, igsum2dv, igsum2dm,&
|
|
& dgsum2ds, dgsum2dv, dgsum2dm,&
|
|
& zgsum2ds, zgsum2dv, zgsum2dm,&
|
|
& sgsum2ds, sgsum2dv, sgsum2dm,&
|
|
& cgsum2ds, cgsum2dv, cgsum2dm
|
|
end interface
|
|
|
|
interface gamx2d
|
|
module procedure igamx2ds, igamx2dv, igamx2dm,&
|
|
& dgamx2ds, dgamx2dv, dgamx2dm,&
|
|
& zgamx2ds, zgamx2dv, zgamx2dm,&
|
|
& sgamx2ds, sgamx2dv, sgamx2dm,&
|
|
& cgamx2ds, cgamx2dv, cgamx2dm
|
|
end interface
|
|
|
|
|
|
interface gamn2d
|
|
module procedure igamn2ds, igamn2dv, igamn2dm,&
|
|
& dgamn2ds, dgamn2dv, dgamn2dm,&
|
|
& zgamn2ds, zgamn2dv, zgamn2dm,&
|
|
& sgamn2ds, sgamn2dv, sgamn2dm,&
|
|
& cgamn2ds, cgamn2dv, cgamn2dm
|
|
end interface
|
|
contains
|
|
|
|
|
|
|
|
subroutine igebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt,dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
character :: top_
|
|
|
|
interface
|
|
subroutine igebs2d(ictxt,scope,top,m,n,v,ld)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine igebs2d
|
|
end interface
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call igebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine igebs2ds
|
|
|
|
subroutine igebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt,dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
|
|
interface
|
|
subroutine igebs2d(ictxt,scope,top,m,n,v,ld)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine igebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call igebs2d(ictxt,scope,top_,size(dat,1),1,dat,size(dat,1))
|
|
|
|
end subroutine igebs2dv
|
|
|
|
subroutine igebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt,dat(:,:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine igebs2d(ictxt,scope,top,m,n,v,ld)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine igebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call igebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine igebs2dm
|
|
|
|
|
|
|
|
subroutine dgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine dgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine dgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call dgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine dgebs2ds
|
|
|
|
subroutine dgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine dgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine dgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call dgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine dgebs2dv
|
|
|
|
subroutine dgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine dgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine dgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call dgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine dgebs2dm
|
|
|
|
|
|
subroutine sgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine sgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine sgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call sgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine sgebs2ds
|
|
|
|
subroutine sgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine sgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine sgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call sgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine sgebs2dv
|
|
|
|
subroutine sgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine sgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine sgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call sgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine sgebs2dm
|
|
|
|
|
|
subroutine zgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine zgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine zgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call zgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine zgebs2ds
|
|
|
|
subroutine zgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine zgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine zgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call zgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine zgebs2dv
|
|
|
|
subroutine zgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine zgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine zgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call zgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine zgebs2dm
|
|
|
|
subroutine cgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine cgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine cgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call cgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine cgebs2ds
|
|
|
|
subroutine cgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine cgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine cgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call cgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine cgebs2dv
|
|
|
|
subroutine cgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine cgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine cgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call cgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine cgebs2dm
|
|
|
|
|
|
|
|
|
|
|
|
subroutine dgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine dgebr2ds
|
|
|
|
subroutine dgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine dgebr2dv
|
|
|
|
subroutine dgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine dgebr2dm
|
|
|
|
|
|
subroutine sgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine sgebr2ds
|
|
|
|
subroutine sgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine sgebr2dv
|
|
|
|
subroutine sgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine sgebr2dm
|
|
|
|
|
|
subroutine zgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine zgebr2ds
|
|
|
|
subroutine zgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine zgebr2dv
|
|
|
|
subroutine zgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine zgebr2dm
|
|
|
|
subroutine cgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine cgebr2ds
|
|
|
|
subroutine cgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine cgebr2dv
|
|
|
|
subroutine cgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine cgebr2dm
|
|
|
|
|
|
|
|
subroutine igebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine igebr2ds
|
|
|
|
subroutine igebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine igebr2dv
|
|
|
|
subroutine igebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine igebr2dm
|
|
|
|
|
|
|
|
subroutine sgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgesd2d
|
|
end interface
|
|
|
|
call sgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine sgesd2ds
|
|
|
|
|
|
subroutine sgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgesd2d
|
|
end interface
|
|
|
|
call sgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine sgesd2dv
|
|
|
|
subroutine sgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
interface
|
|
subroutine sgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call sgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine sgesd2dm
|
|
|
|
|
|
subroutine dgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgesd2d
|
|
end interface
|
|
|
|
call dgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine dgesd2ds
|
|
|
|
|
|
subroutine dgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgesd2d
|
|
end interface
|
|
|
|
call dgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine dgesd2dv
|
|
|
|
subroutine dgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
interface
|
|
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call dgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine dgesd2dm
|
|
|
|
|
|
subroutine igesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igesd2d
|
|
end interface
|
|
|
|
call igesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine igesd2ds
|
|
|
|
|
|
subroutine igesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igesd2d
|
|
end interface
|
|
|
|
call igesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine igesd2dv
|
|
|
|
subroutine igesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call igesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine igesd2dm
|
|
|
|
|
|
|
|
subroutine cgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgesd2d
|
|
end interface
|
|
|
|
call cgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine cgesd2ds
|
|
|
|
|
|
subroutine cgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgesd2d
|
|
end interface
|
|
|
|
call cgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine cgesd2dv
|
|
|
|
subroutine cgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine cgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call cgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine cgesd2dm
|
|
|
|
|
|
subroutine zgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgesd2d
|
|
end interface
|
|
|
|
call zgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine zgesd2ds
|
|
|
|
|
|
subroutine zgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgesd2d
|
|
end interface
|
|
|
|
call zgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine zgesd2dv
|
|
|
|
subroutine zgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call zgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine zgesd2dm
|
|
|
|
|
|
|
|
subroutine sgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgerv2d
|
|
end interface
|
|
|
|
call sgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine sgerv2ds
|
|
|
|
|
|
subroutine sgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgerv2d
|
|
end interface
|
|
|
|
call sgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine sgerv2dv
|
|
|
|
subroutine sgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine sgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgerv2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call sgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine sgerv2dm
|
|
|
|
subroutine dgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgerv2d
|
|
end interface
|
|
|
|
call dgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine dgerv2ds
|
|
|
|
|
|
subroutine dgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgerv2d
|
|
end interface
|
|
|
|
call dgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine dgerv2dv
|
|
|
|
subroutine dgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgerv2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call dgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine dgerv2dm
|
|
|
|
|
|
subroutine igerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igerv2d
|
|
end interface
|
|
|
|
call igerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine igerv2ds
|
|
|
|
|
|
subroutine igerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igerv2d
|
|
end interface
|
|
|
|
call igerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine igerv2dv
|
|
|
|
subroutine igerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igerv2d
|
|
end interface
|
|
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call igerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine igerv2dm
|
|
|
|
|
|
|
|
subroutine cgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgerv2d
|
|
end interface
|
|
|
|
call cgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine cgerv2ds
|
|
|
|
|
|
subroutine cgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgerv2d
|
|
end interface
|
|
|
|
call cgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine cgerv2dv
|
|
|
|
subroutine cgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine cgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgerv2d
|
|
end interface
|
|
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call cgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine cgerv2dm
|
|
|
|
subroutine zgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgerv2d
|
|
end interface
|
|
|
|
call zgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine zgerv2ds
|
|
|
|
|
|
subroutine zgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgerv2d
|
|
end interface
|
|
|
|
call zgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine zgerv2dv
|
|
|
|
subroutine zgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgerv2d
|
|
end interface
|
|
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call zgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine zgerv2dm
|
|
|
|
|
|
|
|
subroutine sgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine sgsum2ds
|
|
|
|
subroutine sgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine sgsum2dv
|
|
|
|
subroutine sgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine sgsum2dm
|
|
|
|
subroutine dgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine dgsum2ds
|
|
|
|
subroutine dgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine dgsum2dv
|
|
|
|
subroutine dgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine dgsum2dm
|
|
|
|
|
|
|
|
subroutine igsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine igsum2ds
|
|
|
|
subroutine igsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine igsum2dv
|
|
|
|
subroutine igsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine igsum2dm
|
|
|
|
|
|
subroutine cgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine cgsum2ds
|
|
|
|
subroutine cgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine cgsum2dv
|
|
|
|
subroutine cgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine cgsum2dm
|
|
|
|
|
|
subroutine zgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine zgsum2ds
|
|
|
|
subroutine zgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine zgsum2dv
|
|
|
|
subroutine zgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine zgsum2dm
|
|
|
|
|
|
subroutine sgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine sgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call sgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call sgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine sgamx2ds
|
|
|
|
|
|
subroutine sgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamx2dv
|
|
|
|
subroutine sgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamx2dm
|
|
|
|
|
|
subroutine dgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine dgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call dgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call dgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine dgamx2ds
|
|
|
|
|
|
subroutine dgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamx2dv
|
|
|
|
subroutine dgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamx2dm
|
|
|
|
|
|
|
|
subroutine igamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine igamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call igamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call igamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine igamx2ds
|
|
|
|
|
|
subroutine igamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamx2dv
|
|
|
|
subroutine igamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
integer, intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamx2dm
|
|
|
|
|
|
subroutine cgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine cgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call cgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call cgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine cgamx2ds
|
|
|
|
|
|
subroutine cgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamx2dv
|
|
|
|
subroutine cgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamx2dm
|
|
|
|
|
|
subroutine zgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine zgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call zgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call zgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine zgamx2ds
|
|
|
|
|
|
subroutine zgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamx2dv
|
|
|
|
subroutine zgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamx2dm
|
|
|
|
|
|
subroutine sgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine sgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call sgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call sgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine sgamn2ds
|
|
|
|
|
|
subroutine sgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamn2dv
|
|
|
|
subroutine sgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamn2dm
|
|
|
|
subroutine dgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine dgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call dgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call dgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine dgamn2ds
|
|
|
|
|
|
subroutine dgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamn2dv
|
|
|
|
subroutine dgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamn2dm
|
|
|
|
|
|
subroutine igamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine igamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call igamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call igamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine igamn2ds
|
|
|
|
|
|
subroutine igamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamn2dv
|
|
|
|
subroutine igamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
integer, intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamn2dm
|
|
|
|
|
|
subroutine cgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine cgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call cgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call cgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine cgamn2ds
|
|
|
|
|
|
subroutine cgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamn2dv
|
|
|
|
subroutine cgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamn2dm
|
|
|
|
subroutine zgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine zgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call zgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call zgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine zgamn2ds
|
|
|
|
|
|
subroutine zgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamn2dv
|
|
|
|
subroutine zgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamn2dm
|
|
|
|
end module psb_blacs_mod
|