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.
4690 lines
116 KiB
Fortran
4690 lines
116 KiB
Fortran
module psb_blacs_mod
|
|
use psb_const_mod
|
|
|
|
interface gebs2d
|
|
module procedure igebs2ds, igebs2dv, igebs2dm,&
|
|
& dgebs2ds, dgebs2dv, dgebs2dm,&
|
|
& zgebs2ds, zgebs2dv, zgebs2dm,&
|
|
& sgebs2ds, sgebs2dv, sgebs2dm,&
|
|
& cgebs2ds, cgebs2dv, cgebs2dm
|
|
end interface
|
|
|
|
interface gebr2d
|
|
module procedure igebr2ds, igebr2dv, igebr2dm,&
|
|
& dgebr2ds, dgebr2dv, dgebr2dm,&
|
|
& zgebr2ds, zgebr2dv, zgebr2dm,&
|
|
& sgebr2ds, sgebr2dv, sgebr2dm,&
|
|
& cgebr2ds, cgebr2dv, cgebr2dm
|
|
|
|
end interface
|
|
|
|
interface gesd2d
|
|
module procedure igesd2ds, igesd2dv, igesd2dm,&
|
|
& dgesd2ds, dgesd2dv, dgesd2dm,&
|
|
& zgesd2ds, zgesd2dv, zgesd2dm,&
|
|
& sgesd2ds, sgesd2dv, sgesd2dm,&
|
|
& cgesd2ds, cgesd2dv, cgesd2dm
|
|
end interface
|
|
|
|
interface gerv2d
|
|
module procedure igerv2ds, igerv2dv, igerv2dm,&
|
|
& dgerv2ds, dgerv2dv, dgerv2dm,&
|
|
& zgerv2ds, zgerv2dv, zgerv2dm,&
|
|
& sgerv2ds, sgerv2dv, sgerv2dm,&
|
|
& cgerv2ds, cgerv2dv, cgerv2dm
|
|
end interface
|
|
|
|
interface gsum2d
|
|
module procedure igsum2ds, igsum2dv, igsum2dm,&
|
|
& dgsum2ds, dgsum2dv, dgsum2dm,&
|
|
& zgsum2ds, zgsum2dv, zgsum2dm,&
|
|
& sgsum2ds, sgsum2dv, sgsum2dm,&
|
|
& cgsum2ds, cgsum2dv, cgsum2dm
|
|
end interface
|
|
|
|
interface gamx2d
|
|
module procedure igamx2ds, igamx2dv, igamx2dm,&
|
|
& dgamx2ds, dgamx2dv, dgamx2dm,&
|
|
& zgamx2ds, zgamx2dv, zgamx2dm,&
|
|
& sgamx2ds, sgamx2dv, sgamx2dm,&
|
|
& cgamx2ds, cgamx2dv, cgamx2dm
|
|
end interface
|
|
|
|
|
|
interface gamn2d
|
|
module procedure igamn2ds, igamn2dv, igamn2dm,&
|
|
& dgamn2ds, dgamn2dv, dgamn2dm,&
|
|
& zgamn2ds, zgamn2dv, zgamn2dm,&
|
|
& sgamn2ds, sgamn2dv, sgamn2dm,&
|
|
& cgamn2ds, cgamn2dv, cgamn2dm
|
|
end interface
|
|
contains
|
|
|
|
|
|
|
|
subroutine igebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt,dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
character :: top_
|
|
|
|
interface
|
|
subroutine igebs2d(ictxt,scope,top,m,n,v,ld)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine igebs2d
|
|
end interface
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call igebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine igebs2ds
|
|
|
|
subroutine igebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt,dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
|
|
interface
|
|
subroutine igebs2d(ictxt,scope,top,m,n,v,ld)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine igebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call igebs2d(ictxt,scope,top_,size(dat,1),1,dat,size(dat,1))
|
|
|
|
end subroutine igebs2dv
|
|
|
|
subroutine igebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt,dat(:,:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine igebs2d(ictxt,scope,top,m,n,v,ld)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine igebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call igebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine igebs2dm
|
|
|
|
|
|
|
|
subroutine dgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine dgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine dgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call dgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine dgebs2ds
|
|
|
|
subroutine dgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine dgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine dgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call dgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine dgebs2dv
|
|
|
|
subroutine dgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine dgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine dgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call dgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine dgebs2dm
|
|
|
|
|
|
subroutine sgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine sgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine sgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call sgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine sgebs2ds
|
|
|
|
subroutine sgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine sgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine sgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call sgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine sgebs2dv
|
|
|
|
subroutine sgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine sgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine sgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call sgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine sgebs2dm
|
|
|
|
|
|
subroutine zgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine zgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine zgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call zgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine zgebs2ds
|
|
|
|
subroutine zgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine zgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine zgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call zgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine zgebs2dv
|
|
|
|
subroutine zgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine zgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine zgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call zgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine zgebs2dm
|
|
|
|
subroutine cgebs2ds(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine cgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v
|
|
character, intent(in) :: scope, top
|
|
end subroutine cgebs2d
|
|
end interface
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call cgebs2d(ictxt,scope,top_,1,1,dat,1)
|
|
|
|
end subroutine cgebs2ds
|
|
|
|
subroutine cgebs2dv(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine cgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine cgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call cgebs2d(ictxt,scope,top_,size(dat),1,dat,size(dat))
|
|
|
|
end subroutine cgebs2dv
|
|
|
|
subroutine cgebs2dm(ictxt,scope,dat,top)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
|
|
interface
|
|
subroutine cgebs2d(ictxt,scope,top,m,n,v,ld)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
end subroutine cgebs2d
|
|
end interface
|
|
|
|
character :: top_
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
|
|
call cgebs2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1))
|
|
|
|
end subroutine cgebs2dm
|
|
|
|
|
|
|
|
|
|
|
|
subroutine dgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine dgebr2ds
|
|
|
|
subroutine dgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine dgebr2dv
|
|
|
|
subroutine dgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine dgebr2dm
|
|
|
|
|
|
subroutine sgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine sgebr2ds
|
|
|
|
subroutine sgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine sgebr2dv
|
|
|
|
subroutine sgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine sgebr2dm
|
|
|
|
|
|
subroutine zgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine zgebr2ds
|
|
|
|
subroutine zgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine zgebr2dv
|
|
|
|
subroutine zgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine zgebr2dm
|
|
|
|
subroutine cgebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine cgebr2ds
|
|
|
|
subroutine cgebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine cgebr2dv
|
|
|
|
subroutine cgebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine cgebr2dm
|
|
|
|
|
|
|
|
subroutine igebr2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igebr2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igebr2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine igebr2ds
|
|
|
|
subroutine igebr2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igebr2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine igebr2dv
|
|
|
|
subroutine igebr2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igebr2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igebr2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
integer :: rrt_, crt_
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = 0
|
|
case('C','c')
|
|
rrt_ = 0
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
case default
|
|
rrt_ = 0
|
|
crt_ = 0
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igebr2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine igebr2dm
|
|
|
|
|
|
|
|
subroutine sgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgesd2d
|
|
end interface
|
|
|
|
call sgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine sgesd2ds
|
|
|
|
|
|
subroutine sgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgesd2d
|
|
end interface
|
|
|
|
call sgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine sgesd2dv
|
|
|
|
subroutine sgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
interface
|
|
subroutine sgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call sgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine sgesd2dm
|
|
|
|
|
|
subroutine dgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgesd2d
|
|
end interface
|
|
|
|
call dgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine dgesd2ds
|
|
|
|
|
|
subroutine dgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgesd2d
|
|
end interface
|
|
|
|
call dgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine dgesd2dv
|
|
|
|
subroutine dgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
interface
|
|
subroutine dgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call dgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine dgesd2dm
|
|
|
|
|
|
subroutine igesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igesd2d
|
|
end interface
|
|
|
|
call igesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine igesd2ds
|
|
|
|
|
|
subroutine igesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igesd2d
|
|
end interface
|
|
|
|
call igesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine igesd2dv
|
|
|
|
subroutine igesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine igesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call igesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine igesd2dm
|
|
|
|
|
|
|
|
subroutine cgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgesd2d
|
|
end interface
|
|
|
|
call cgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine cgesd2ds
|
|
|
|
|
|
subroutine cgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgesd2d
|
|
end interface
|
|
|
|
call cgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine cgesd2dv
|
|
|
|
subroutine cgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine cgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call cgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine cgesd2dm
|
|
|
|
|
|
subroutine zgesd2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgesd2d
|
|
end interface
|
|
|
|
call zgesd2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine zgesd2ds
|
|
|
|
|
|
subroutine zgesd2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgesd2d
|
|
end interface
|
|
|
|
call zgesd2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine zgesd2dv
|
|
|
|
subroutine zgesd2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(in) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine zgesd2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(in) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgesd2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call zgesd2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine zgesd2dm
|
|
|
|
|
|
|
|
subroutine sgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgerv2d
|
|
end interface
|
|
|
|
call sgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine sgerv2ds
|
|
|
|
|
|
subroutine sgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine sgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgerv2d
|
|
end interface
|
|
|
|
call sgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine sgerv2dv
|
|
|
|
subroutine sgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine sgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine sgerv2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call sgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine sgerv2dm
|
|
|
|
subroutine dgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgerv2d
|
|
end interface
|
|
|
|
call dgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine dgerv2ds
|
|
|
|
|
|
subroutine dgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgerv2d
|
|
end interface
|
|
|
|
call dgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine dgerv2dv
|
|
|
|
subroutine dgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine dgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine dgerv2d
|
|
end interface
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call dgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine dgerv2dm
|
|
|
|
|
|
subroutine igerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igerv2d
|
|
end interface
|
|
|
|
call igerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine igerv2ds
|
|
|
|
|
|
subroutine igerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igerv2d
|
|
end interface
|
|
|
|
call igerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine igerv2dv
|
|
|
|
subroutine igerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine igerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine igerv2d
|
|
end interface
|
|
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call igerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine igerv2dm
|
|
|
|
|
|
|
|
subroutine cgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgerv2d
|
|
end interface
|
|
|
|
call cgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine cgerv2ds
|
|
|
|
|
|
subroutine cgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine cgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgerv2d
|
|
end interface
|
|
|
|
call cgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine cgerv2dv
|
|
|
|
subroutine cgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine cgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine cgerv2d
|
|
end interface
|
|
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call cgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine cgerv2dm
|
|
|
|
subroutine zgerv2ds(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgerv2d
|
|
end interface
|
|
|
|
call zgerv2d(ictxt,1,1,dat,1,rdst,cdst)
|
|
|
|
end subroutine zgerv2ds
|
|
|
|
|
|
subroutine zgerv2dv(ictxt,dat,rdst,cdst)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
integer, intent(in) :: rdst,cdst
|
|
|
|
interface
|
|
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgerv2d
|
|
end interface
|
|
|
|
call zgerv2d(ictxt,size(dat),1,dat,size(dat),rdst,cdst)
|
|
|
|
end subroutine zgerv2dv
|
|
|
|
subroutine zgerv2dm(ictxt,dat,rdst,cdst,m)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
integer, intent(in) :: rdst,cdst
|
|
integer, intent(in), optional :: m
|
|
|
|
integer :: m_
|
|
|
|
interface
|
|
subroutine zgerv2d(ictxt,m,n,v,ld,rd,cd)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(in) :: rd,cd
|
|
end subroutine zgerv2d
|
|
end interface
|
|
|
|
|
|
if (present(m)) then
|
|
m_ = m
|
|
else
|
|
m_ = size(dat,1)
|
|
endif
|
|
|
|
call zgerv2d(ictxt,m_,size(dat,2),dat,size(dat,1),rdst,cdst)
|
|
|
|
end subroutine zgerv2dm
|
|
|
|
|
|
|
|
subroutine sgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine sgsum2ds
|
|
|
|
subroutine sgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine sgsum2dv
|
|
|
|
subroutine sgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call sgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine sgsum2dm
|
|
|
|
subroutine dgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine dgsum2ds
|
|
|
|
subroutine dgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine dgsum2dv
|
|
|
|
subroutine dgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call dgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine dgsum2dm
|
|
|
|
|
|
|
|
subroutine igsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine igsum2ds
|
|
|
|
subroutine igsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine igsum2dv
|
|
|
|
subroutine igsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call igsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine igsum2dm
|
|
|
|
|
|
subroutine cgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine cgsum2ds
|
|
|
|
subroutine cgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine cgsum2dv
|
|
|
|
subroutine cgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call cgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine cgsum2dm
|
|
|
|
|
|
subroutine zgsum2ds(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgsum2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgsum2d(ictxt,scope,top_,1,1,dat,1,rrt_,crt_)
|
|
|
|
end subroutine zgsum2ds
|
|
|
|
subroutine zgsum2dv(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgsum2d(ictxt,scope,top_,size(dat),1,dat,size(dat),rrt_,crt_)
|
|
|
|
end subroutine zgsum2dv
|
|
|
|
subroutine zgsum2dm(ictxt,scope,dat,top,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgsum2d(ictxt,scope,top,m,n,v,ld,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgsum2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
call zgsum2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),rrt_,crt_)
|
|
|
|
end subroutine zgsum2dm
|
|
|
|
|
|
subroutine sgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine sgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call sgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call sgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine sgamx2ds
|
|
|
|
|
|
subroutine sgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamx2dv
|
|
|
|
subroutine sgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamx2dm
|
|
|
|
|
|
subroutine dgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine dgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call dgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call dgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine dgamx2ds
|
|
|
|
|
|
subroutine dgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamx2dv
|
|
|
|
subroutine dgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamx2dm
|
|
|
|
|
|
|
|
subroutine igamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine igamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call igamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call igamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine igamx2ds
|
|
|
|
|
|
subroutine igamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamx2dv
|
|
|
|
subroutine igamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
integer, intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamx2dm
|
|
|
|
|
|
subroutine cgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine cgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call cgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call cgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine cgamx2ds
|
|
|
|
|
|
subroutine cgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamx2dv
|
|
|
|
subroutine cgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamx2dm
|
|
|
|
|
|
subroutine zgamx2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine zgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamx2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call zgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call zgamx2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine zgamx2ds
|
|
|
|
|
|
subroutine zgamx2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamx2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamx2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamx2dv
|
|
|
|
subroutine zgamx2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamx2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgamx2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamx2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamx2dm
|
|
|
|
|
|
subroutine sgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine sgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call sgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call sgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine sgamn2ds
|
|
|
|
|
|
subroutine sgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine sgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamn2dv
|
|
|
|
subroutine sgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine sgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine sgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call sgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call sgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine sgamn2dm
|
|
|
|
subroutine dgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine dgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call dgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call dgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine dgamn2ds
|
|
|
|
|
|
subroutine dgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
real(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine dgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamn2dv
|
|
|
|
subroutine dgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
real(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine dgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
real(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine dgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call dgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call dgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine dgamn2dm
|
|
|
|
|
|
subroutine igamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine igamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call igamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call igamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine igamn2ds
|
|
|
|
|
|
subroutine igamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
integer, intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine igamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamn2dv
|
|
|
|
subroutine igamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
integer, intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine igamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
integer, intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine igamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call igamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call igamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine igamn2dm
|
|
|
|
|
|
subroutine cgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine cgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call cgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call cgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine cgamn2ds
|
|
|
|
|
|
subroutine cgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_spk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine cgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamn2dv
|
|
|
|
subroutine cgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_spk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine cgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_spk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine cgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call cgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call cgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine cgamn2dm
|
|
|
|
subroutine zgamn2ds(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
integer, intent(inout), optional :: ria,cia
|
|
|
|
interface
|
|
subroutine zgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamn2d
|
|
end interface
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).or.present(cia)) then
|
|
call zgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,1,rrt_,crt_)
|
|
if (present(ria)) ria=ria_(1)
|
|
if (present(cia)) cia=cia_(1)
|
|
else
|
|
call zgamn2d(ictxt,scope,top_,1,1,dat,1,ria_,cia_,-1,rrt_,crt_)
|
|
endif
|
|
end subroutine zgamn2ds
|
|
|
|
|
|
subroutine zgamn2dv(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:)
|
|
character, intent(in) :: scope
|
|
character, intent(in), optional :: top
|
|
integer, intent(inout), optional :: ria(:),cia(:)
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld
|
|
complex(psb_dpk_), intent(inout) :: v(*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(inout) :: ria(*),cia(*)
|
|
integer, intent(in) :: rrt,crt,ldia
|
|
end subroutine zgamn2d
|
|
end interface
|
|
|
|
integer :: ldia_,ria_(1),cia_(1)
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria,cia,min(size(ria),size(cia)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamn2d(ictxt,scope,top_,size(dat),1,dat,size(dat),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamn2dv
|
|
|
|
subroutine zgamn2dm(ictxt,scope,dat,top,ria,cia,rrt,crt)
|
|
integer, intent(in) :: ictxt
|
|
complex(psb_dpk_), intent(inout) :: dat(:,:)
|
|
character, intent(in) :: scope
|
|
integer, intent(inout), optional :: ria(:,:),cia(:,:)
|
|
character, intent(in), optional :: top
|
|
integer, intent(in), optional :: rrt,crt
|
|
|
|
interface
|
|
subroutine zgamn2d(ictxt,scope,top,m,n,v,ld,ria,cia,ldia,rrt,crt)
|
|
use psb_const_mod
|
|
integer, intent(in) :: ictxt,m,n,ld,ldia
|
|
complex(psb_dpk_), intent(inout) :: v(ld,*)
|
|
integer, intent(inout) :: ria(ldia,*),cia(ldia,*)
|
|
character, intent(in) :: scope, top
|
|
integer, intent(in) :: rrt,crt
|
|
end subroutine zgamn2d
|
|
end interface
|
|
|
|
character :: top_
|
|
integer :: rrt_, crt_
|
|
integer :: ldia_,ria_(1,1),cia_(1,1)
|
|
integer :: nrows,ncols,myrow,mycol
|
|
|
|
|
|
call blacs_gridinfo(ictxt,nrows,ncols,myrow,mycol)
|
|
select case(scope)
|
|
case('R','r')
|
|
rrt_ = myrow
|
|
crt_ = -1
|
|
case('C','c')
|
|
rrt_ = -1
|
|
crt_ = mycol
|
|
case('A','a')
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
case default
|
|
rrt_ = -1
|
|
crt_ = -1
|
|
end select
|
|
|
|
|
|
if (present(top)) then
|
|
top_ = top
|
|
else
|
|
top_ = ' '
|
|
endif
|
|
if (present(rrt)) then
|
|
rrt_ = rrt
|
|
endif
|
|
if (present(crt)) then
|
|
crt_ = crt
|
|
endif
|
|
|
|
if (present(ria).and.present(cia)) then
|
|
call zgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria,cia,min(size(ria,1),size(cia,1)),rrt_,crt_)
|
|
else
|
|
ldia_ = -1
|
|
call zgamn2d(ictxt,scope,top_,size(dat,1),size(dat,2),dat,size(dat,1),&
|
|
& ria_,cia_,ldia_,rrt_,crt_)
|
|
end if
|
|
|
|
end subroutine zgamn2dm
|
|
|
|
end module psb_blacs_mod
|