You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
psblas3/base/modules/psb_blacs_mod.f90

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