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

Start of interface fixing for CDALL and friends.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 6e5df61dc0
commit 99fa0fdc20
4 changed files with 40 additions and 40 deletions
Show Stats Download Patch File Download Diff File

8
base/modules/tools/psb_cd_tools_mod.f90
Unescape Escape View File

@ -156,18 +156,18 @@ module psb_cd_tools_mod
interface psb_cdall
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl,&
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,&
& globalcheck,lidx)
import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts
implicit None
procedure(psb_parts) :: parts
integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:)
integer(psb_lpk_), intent(in) :: vll(:)
integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx,vll
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
end subroutine psb_cdall
end interface

10
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
use psb_hash_map_mod
implicit None
!....Parameters...
integer(psb_ipk_), intent(in) :: ictxt, v(:)
integer(psb_ipk_), intent(in) :: ictxt
integer(psb_lpk_), intent(in) :: v(:)
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck
@ -57,9 +58,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
!locals
integer(psb_ipk_) :: i,j,np,me,loc_row,err,&
& loc_col,nprocs,n, k,glx,nlu,&
& flag_, err_act,m, novrl, norphan,&
& npr_ov, itmpov, i_pnt, nrt
& loc_col,nprocs,k,glx,nlu,&
& flag_, err_act, novrl, norphan,&
& npr_ov, itmpov, i_pnt
integer(psb_lpk) :: m, n, nrt
integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_ipk_), allocatable :: temp_ovrlap(:), tmpgidx(:,:), vl(:),&
& nov(:), ov_idx(:,:), ix(:)

41
base/tools/psb_cdall.f90
Unescape Escape View File

@ -1,4 +1,4 @@
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globalcheck,lidx)
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx)
use psb_desc_mod
use psb_serial_mod
use psb_const_mod
@ -8,22 +8,23 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
use psi_mod
implicit None
procedure(psb_parts) :: parts
integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:)
integer(psb_lpk_), intent(in) :: vll(:)
integer(psb_ipk_), intent(in) :: flag
integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,vll,flag,nl,repl, globalcheck,lidx
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
interface
subroutine psb_cdals(m, n, parts, ictxt, desc, info)
use psb_desc_mod
procedure(psb_parts) :: parts
integer(psb_ipk_), intent(in) :: m,n,ictxt
Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in) :: m,n
integer(psb_ipk_), intent(in) :: ictxt
Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdals
subroutine psb_cdalv(v, ictxt, desc, info, flag)
use psb_desc_mod
@ -33,15 +34,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
Type(psb_desc_type), intent(out) :: desc
end subroutine psb_cdalv
subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
use psb_desc_mod
implicit None
integer(psb_ipk_), intent(in) :: ictxt, v(:)
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck
integer(psb_ipk_), intent(in), optional :: idx(:)
end subroutine psb_cd_inloc
subroutine psb_cd_inlocl(v, ictxt, desc, info, globalcheck,idx)
use psb_desc_mod
implicit None
integer(psb_ipk_), intent(in) :: ictxt
@ -50,16 +42,18 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
type(psb_desc_type), intent(out) :: desc
logical, intent(in), optional :: globalcheck
integer(psb_ipk_), intent(in), optional :: idx(:)
end subroutine psb_cd_inlocl
end subroutine psb_cd_inloc
subroutine psb_cdrep(m, ictxt, desc,info)
use psb_desc_mod
integer(psb_ipk_), intent(in) :: m,ictxt
integer(psb_lpk_), intent(in) :: m
integer(psb_ipk_), intent(in) :: ictxt
Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdrep
end interface
character(len=20) :: name
integer(psb_ipk_) :: err_act, n_, flag_, i, me, np, nlp, nnv, lr
integer(psb_ipk_) :: err_act, flag_, i, me, np, nlp, nnv, lr
integer(psb_lpk_) :: n_
integer(psb_ipk_), allocatable :: itmpsz(:)
integer(psb_mpk_) :: iictxt
@ -149,8 +143,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,vll,flag,nl,repl, globa
end if
if (info == psb_success_) then
select type(aa => desc%indxmap)
type is (psb_repl_map)
call aa%repl_map_init(iictxt,nl,info)
type is (psb_repl_map)
n_ = nl
call aa%repl_map_init(iictxt,n_,info)
type is (psb_gen_block_map)
call aa%gen_block_map_init(iictxt,nl,info)
class default

21
base/tools/psb_cdals.f90
Unescape Escape View File

@ -52,15 +52,18 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
implicit None
procedure(psb_parts) :: parts
!....Parameters...
integer(psb_ipk_), intent(in) :: M,N,ictxt
integer(psb_lpk_), intent(in) :: M,N
integer(psb_ipk_), intent(in) :: ictxt
Type(psb_desc_type), intent(out) :: desc
integer(psb_ipk_), intent(out) :: info
!locals
integer(psb_ipk_) :: counter,i,j,loc_row,err,loc_col,&
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k, glx, nlx
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k, glx, nlx
integer(psb_lpk_) :: iglob
integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_ipk_), allocatable :: temp_ovrlap(:), loc_idx(:)
integer(psb_lpk_), allocatable :: loc_idx(:)
integer(psb_ipk_), allocatable :: temp_ovrlap(:)
integer(psb_ipk_), allocatable :: prc_v(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: me, np, nprocs
@ -174,15 +177,15 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
desc%lprm(1) = 0
k = 0
do i=1,m
do iglob=1,m
if (info == psb_success_) then
call parts(i,m,np,prc_v,nprocs)
call parts(iglob,m,np,prc_v,nprocs)
if (nprocs > np) then
info=psb_err_partfunc_toomuchprocs_
int_err(1)=3
int_err(2)=np
int_err(3)=nprocs
int_err(4)=i
int_err(4)=iglob
err=info
call psb_errpush(err,name,int_err)
goto 9999
@ -190,7 +193,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
info=psb_err_partfunc_toofewprocs_
int_err(1)=3
int_err(2)=nprocs
int_err(3)=i
int_err(3)=iglob
err=info
call psb_errpush(err,name,int_err)
goto 9999
@ -200,7 +203,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
info=psb_err_partfunc_wrong_pid_
int_err(1)=3
int_err(2)=prc_v(j)
int_err(3)=i
int_err(3)=iglob
err=info
call psb_errpush(err,name,int_err)
goto 9999
@ -218,7 +221,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
if (prc_v(j) == me) then
! this point belongs to me
k = k + 1
call psb_ensure_size((k+1),loc_idx,info,pad=-ione)
call psb_ensure_size((k+1),loc_idx,info,pad=-1_psb_lpk_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_ensure_size')

Write Preview
Loading…
Cancel
Save