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) subroutine psb_ibcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
integer, intent(inout) :: dat 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_ibcasts end subroutine psb_ibcasts
subroutine psb_ibcastv(ictxt,dat,root) subroutine psb_ibcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:) 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_ibcastv end subroutine psb_ibcastv
subroutine psb_ibcastm(ictxt,dat,root) subroutine psb_ibcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:) 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_ibcastm end subroutine psb_ibcastm
subroutine psb_dbcasts(ictxt,dat,root) subroutine psb_dbcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_dbcasts end subroutine psb_dbcasts
subroutine psb_dbcastv(ictxt,dat,root) subroutine psb_dbcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:) 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_dbcastv end subroutine psb_dbcastv
subroutine psb_dbcastm(ictxt,dat,root) subroutine psb_dbcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:) 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_dbcastm end subroutine psb_dbcastm
subroutine psb_zbcasts(ictxt,dat,root) subroutine psb_zbcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat complex(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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_zbcasts end subroutine psb_zbcasts
subroutine psb_zbcastv(ictxt,dat,root) subroutine psb_zbcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:) 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_zbcastv end subroutine psb_zbcastv
subroutine psb_zbcastm(ictxt,dat,root) subroutine psb_zbcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:,:) 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) call psb_info(ictxt,iam,np)
if (iam==root) then if (iam==root_) then
call gebs2d(ictxt,'A',dat) call gebs2d(ictxt,'A',dat)
else else
call gebr2d(ictxt,'A',dat,rrt=root) call gebr2d(ictxt,'A',dat,rrt=root_)
endif endif
end subroutine psb_zbcastm end subroutine psb_zbcastm
subroutine psb_iamxs(ictxt,dat,rt,ia) subroutine psb_iamxs(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt integer, intent(in) :: ictxt
integer, intent(inout) :: dat 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)) INPARMS(I) = IACHAR(MTRX_FILE(I:I))
END DO END DO
! Broadcast parameters to all processors ! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40),0) call psb_bcast(ictxt,inparms(1:40))
! Convert strings in array ! Convert strings in array
DO I = 1, LEN(CMETHD) DO I = 1, LEN(CMETHD)
INPARMS(I) = IACHAR(CMETHD(I:I)) INPARMS(I) = IACHAR(CMETHD(I:I))
END DO END DO
! Broadcast parameters to all processors ! 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) DO I = 1, LEN(AFMT)
INPARMS(I) = IACHAR(AFMT(I:I)) INPARMS(I) = IACHAR(AFMT(I:I))
END DO END DO
! Broadcast parameters to all processors ! Broadcast parameters to all processors
call psb_bcast(ictxt,inparms(1:40),0) call psb_bcast(ictxt,inparms(1:40))
READ(*,*) IPART READ(*,*) IPART
IF (IP.GE.5) THEN IF (IP.GE.5) THEN
@ -118,8 +118,8 @@ CONTAINS
INPARMS(4) = ITRACE INPARMS(4) = ITRACE
INPARMS(5) = IPREC INPARMS(5) = IPREC
INPARMS(6) = NOVR INPARMS(6) = NOVR
call psb_bcast(ictxt,inparms(1:6),0) call psb_bcast(ictxt,inparms(1:6))
call psb_bcast(ictxt,eps,0) call psb_bcast(ictxt,eps)
write(*,'("Solving matrix : ",a40)')mtrx_file write(*,'("Solving matrix : ",a40)')mtrx_file
write(*,'("Number of processors : ",i3)')nprow write(*,'("Number of processors : ",i3)')nprow
@ -136,23 +136,23 @@ CONTAINS
end if end if
else else
! Receive Parameters ! Receive Parameters
call psb_bcast(ictxt,inparms(1:40),0) call psb_bcast(ictxt,inparms(1:40))
do i = 1, 40 do i = 1, 40
mtrx_file(i:i) = achar(inparms(i)) mtrx_file(i:i) = achar(inparms(i))
end do end do
call psb_bcast(ictxt,inparms(1:40),0) call psb_bcast(ictxt,inparms(1:40))
DO I = 1, 40 DO I = 1, 40
CMETHD(I:I) = ACHAR(INPARMS(I)) CMETHD(I:I) = ACHAR(INPARMS(I))
END DO END DO
call psb_bcast(ictxt,inparms(1:40),0) call psb_bcast(ictxt,inparms(1:40))
DO I = 1, LEN(AFMT) DO I = 1, LEN(AFMT)
AFMT(I:I) = ACHAR(INPARMS(I)) AFMT(I:I) = ACHAR(INPARMS(I))
END DO END DO
call psb_bcast(ictxt,inparms(1:6),0) call psb_bcast(ictxt,inparms(1:6))
ipart = inparms(1) ipart = inparms(1)
istopc = inparms(2) istopc = inparms(2)
@ -160,7 +160,7 @@ CONTAINS
itrace = inparms(4) itrace = inparms(4)
iprec = inparms(5) iprec = inparms(5)
novr = inparms(6) novr = inparms(6)
call psb_bcast(ictxt,eps,0) call psb_bcast(ictxt,eps)
end if end if

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

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

Write Preview
Loading…
Cancel
Save