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

Changed psb_bcast by making root an optional argument.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 0f676f520d
commit 10d7c952b1
3 changed files with 120 additions and 57 deletions
Show Stats Download Patch File Download Diff File

137
src/modules/psb_blacs_mod.f90
Unescape Escape View File

@ -215,144 +215,207 @@ contains
subroutine psb_ibcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
integer, intent(inout) :: dat
integer, intent(in), optional :: root
integer :: iam, np
integer :: iam, np, root_
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_ibcasts
subroutine psb_ibcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: iam, np, root_
integer :: iam, np
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_ibcastv
subroutine psb_ibcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: iam, np
integer :: iam, np, root_
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_ibcastm
subroutine psb_dbcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat
integer, intent(in), optional :: root
integer :: iam, np, root_
integer :: iam, np
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_dbcasts
subroutine psb_dbcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: iam, np
integer :: iam, np, root_
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_dbcastv
subroutine psb_dbcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: iam, np, root_
integer :: iam, np
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_dbcastm
subroutine psb_zbcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat
integer, intent(in), optional :: root
integer :: iam, np
integer :: iam, np, root_
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_zbcasts
subroutine psb_zbcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: iam, np
integer :: iam, np, root_
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_zbcastv
subroutine psb_zbcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: iam, np
integer :: iam, np, root_
if (present(root)) then
root_ = root
else
root_ = 0
endif
call psb_info(ictxt,iam,np)
if (iam==root) then
if (iam==root_) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
call gebr2d(ictxt,'A',dat,rrt=root_)
endif
end subroutine psb_zbcastm
subroutine psb_iamxs(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat

20
test/Fileread/getp.f90
Unescape Escape View File

@ -64,20 +64,20 @@ CONTAINS
INPARMS(I) = IACHAR(MTRX_FILE(I:I))
END DO
! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40),0)
call psb_bcast(ictxt,inparms(1:40))
! Convert strings in array
DO I = 1, LEN(CMETHD)
INPARMS(I) = IACHAR(CMETHD(I:I))
END DO
! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40),0)
call psb_bcast(ictxt,inparms(1:40))
DO I = 1, LEN(AFMT)
INPARMS(I) = IACHAR(AFMT(I:I))
END DO
! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40),0)
call psb_bcast(ictxt,inparms(1:40))
READ(*,*) IPART
IF (IP.GE.5) THEN
@ -118,8 +118,8 @@ CONTAINS
INPARMS(4) = ITRACE
INPARMS(5) = IPREC
INPARMS(6) = NOVR
call psb_bcast(ictxt,inparms(1:6),0)
call psb_bcast(ictxt,eps,0)
call psb_bcast(ictxt,inparms(1:6))
call psb_bcast(ictxt,eps)
write(*,'("Solving matrix : ",a40)')mtrx_file
write(*,'("Number of processors : ",i3)')nprow
@ -136,23 +136,23 @@ CONTAINS
end if
else
! Receive Parameters
call psb_bcast(ictxt,inparms(1:40),0)
call psb_bcast(ictxt,inparms(1:40))
do i = 1, 40
mtrx_file(i:i) = achar(inparms(i))
end do
call psb_bcast(ictxt,inparms(1:40),0)
call psb_bcast(ictxt,inparms(1:40))
DO I = 1, 40
CMETHD(I:I) = ACHAR(INPARMS(I))
END DO
call psb_bcast(ictxt,inparms(1:40),0)
call psb_bcast(ictxt,inparms(1:40))
DO I = 1, LEN(AFMT)
AFMT(I:I) = ACHAR(INPARMS(I))
END DO
call psb_bcast(ictxt,inparms(1:6),0)
call psb_bcast(ictxt,inparms(1:6))
ipart = inparms(1)
istopc = inparms(2)
@ -160,7 +160,7 @@ CONTAINS
itrace = inparms(4)
iprec = inparms(5)
novr = inparms(6)
call psb_bcast(ictxt,eps,0)
call psb_bcast(ictxt,eps)
end if

20
test/pargen/ppde90.f90
Unescape Escape View File

@ -287,16 +287,16 @@ contains
intbuf(i) = iachar(cmethd(i:i))
end do
! broadcast parameters to all processors
call psb_bcast(ictxt,intbuf(1:10),0)
call psb_bcast(ictxt,intbuf(1:10))
! broadcast parameters to all processors
call psb_bcast(ictxt,iprec,0)
call psb_bcast(ictxt,novr,0)
call psb_bcast(ictxt,iprec)
call psb_bcast(ictxt,novr)
do i = 1, len(afmt)
intbuf(i) = iachar(afmt(i:i))
end do
call psb_bcast(ictxt,intbuf(1:10),0)
call psb_bcast(ictxt,intbuf(1:10))
read(*,*) idim
if (ip.ge.4) then
@ -326,7 +326,7 @@ contains
intbuf(3) = itmax
intbuf(4) = itrace
intbuf(5) = ml
call psb_bcast(ictxt,intbuf(1:5),0)
call psb_bcast(ictxt,intbuf(1:5))
write(*,'("Solving matrix : ell1")')
write(*,'("Grid dimensions : ",i4,"x",i4,"x",i4)')idim,idim,idim
@ -343,19 +343,19 @@ contains
stop 1
endif
else
call psb_bcast(ictxt,intbuf(1:10),0)
call psb_bcast(ictxt,intbuf(1:10))
do i = 1, 10
cmethd(i:i) = achar(intbuf(i))
end do
call psb_bcast(ictxt,iprec,0)
call psb_bcast(ictxt,novr,0)
call psb_bcast(ictxt,intbuf(1:10),0)
call psb_bcast(ictxt,iprec)
call psb_bcast(ictxt,novr)
call psb_bcast(ictxt,intbuf(1:10))
do i = 1, 5
afmt(i:i) = achar(intbuf(i))
end do
call psb_bcast(ictxt,intbuf(1:5),0)
call psb_bcast(ictxt,intbuf(1:5))
idim = intbuf(1)
istopc = intbuf(2)
itmax = intbuf(3)

Write Preview
Loading…
Cancel
Save