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

Added psblas interfaces to BLACS. Step 2: up to AMX

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent fab80eee68
commit c56e74c0f0
14 changed files with 570 additions and 219 deletions
Show Stats Download Patch File Download Diff File

6
Make.inc
Unescape Escape View File

@ -10,9 +10,9 @@ F90=/usr/local/gcc42/bin/gfortran
FC=/usr/local/gcc42/bin/gfortran
F77=$(FC)
CC=/usr/local/gcc42/bin/gcc
F90COPT= -O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
FCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
CCOPT=-O3 -ffast-math -march=pentium4 -msse2 -mfpmath=sse
F90COPT= -O3 -march=pentium4 -msse2 -mfpmath=sse
FCOPT=-O3 -march=pentium4 -msse2 -mfpmath=sse
CCOPT=-O3 -march=pentium4 -msse2 -mfpmath=sse
####################### Section 2 #######################
# Define your linker and linker flags here #

1
src/modules/Makefile
Unescape Escape View File

@ -17,6 +17,7 @@ psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o
psb_error_mod.o: psb_const_mod.o
psb_const_mod.f90: psb_const.fh
psb_blacs_mod.o : psb_const_mod.o psb_error_mod.o
lib: $(MODULES) $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS)

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

@ -74,8 +74,469 @@ module psb_blacs_mod
& zgamn2ds, zgamn2dv, zgamn2dm
end interface
interface psb_init
module procedure psb_init
end interface
interface psb_exit
module procedure psb_exit
end interface
interface psb_abort
module procedure psb_abort
end interface
interface psb_info
module procedure psb_info
end interface
interface psb_barrier
module procedure psb_barrier
end interface
interface psb_bcast
module procedure psb_ibcasts, psb_ibcastv, psb_ibcastm,&
& psb_dbcasts, psb_dbcastv, psb_dbcastm,&
& psb_zbcasts, psb_zbcastv, psb_zbcastm
end interface
interface psb_amx
module procedure psb_iamxs, psb_iamxv, psb_iamxm,&
& psb_damxs, psb_damxv, psb_damxm,&
& psb_zamxs, psb_zamxv, psb_zamxm
end interface
contains
subroutine psb_init(ictxt,np)
use psb_const_mod
use psb_error_mod
integer, intent(out) :: ictxt
integer, intent(in), optional :: np
integer :: np_, npavail, iam, info
character(len=20), parameter :: name='psb_init'
call blacs_pinfo(iam, npavail)
call blacs_get(izero, izero, ictxt)
if (present(np)) then
np_ = max(1,min(np,npavail))
else
np_ = npavail
endif
call blacs_gridinit(ictxt, 'R', np_, ione)
if (present(np)) then
if (np_ < np) then
info = 2011
call psb_errpush(info,name)
call psb_error(ictxt)
endif
endif
end subroutine psb_init
subroutine psb_exit(ictxt)
integer, intent(in) :: ictxt
integer :: nprow, npcol, myprow, mypcol
call blacs_gridinfo(ictxt, nprow, npcol, myprow, mypcol)
if ((myprow >=0).and.(mypcol>=0)) then
call blacs_gridexit(ictxt)
end if
call blacs_exit(0)
end subroutine psb_exit
subroutine psb_barrier(ictxt)
integer, intent(in) :: ictxt
call blacs_barrier(ictxt,'All')
end subroutine psb_barrier
subroutine psb_abort(ictxt)
integer, intent(in) :: ictxt
call blacs_abort(ictxt,-1)
end subroutine psb_abort
subroutine psb_info(ictxt,iam,np)
integer, intent(in) :: ictxt
integer, intent(out) :: iam, np
integer :: nprow, npcol, myprow, mypcol
call blacs_gridinfo(ictxt, nprow, npcol, myprow, mypcol)
iam = myprow
np = nprow
end subroutine psb_info
subroutine psb_ibcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root
integer, intent(inout) :: dat
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
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(inout) :: dat(:)
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
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(inout) :: dat(:,:)
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
endif
end subroutine psb_ibcastm
subroutine psb_dbcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root
real(kind(1.d0)), intent(inout) :: dat
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
endif
end subroutine psb_dbcasts
subroutine psb_dbcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root
real(kind(1.d0)), intent(inout) :: dat(:)
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
endif
end subroutine psb_dbcastv
subroutine psb_dbcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
endif
end subroutine psb_dbcastm
subroutine psb_zbcasts(ictxt,dat,root)
integer, intent(in) :: ictxt,root
complex(kind(1.d0)), intent(inout) :: dat
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
endif
end subroutine psb_zbcasts
subroutine psb_zbcastv(ictxt,dat,root)
integer, intent(in) :: ictxt,root
complex(kind(1.d0)), intent(inout) :: dat(:)
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
call gebr2d(ictxt,'A',dat,rrt=root)
endif
end subroutine psb_zbcastv
subroutine psb_zbcastm(ictxt,dat,root)
integer, intent(in) :: ictxt,root
complex(kind(1.d0)), intent(inout) :: dat(:,:)
integer :: iam, np
call psb_info(ictxt,iam,np)
if (iam==root) then
call gebs2d(ictxt,'A',dat)
else
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
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia
integer :: rt_
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
call gamx2d(ictxt,'A',dat,ria=ia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_iamxs
subroutine psb_iamxv(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:)
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia(:)
integer :: rt_
integer, allocatable :: cia(:)
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
allocate(cia(size(ia)))
call gamx2d(ictxt,'A',dat,ria=ia,cia=cia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_iamxv
subroutine psb_iamxm(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:)
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia(:,:)
integer :: rt_
integer, allocatable :: cia(:,:)
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
allocate(cia(size(ia,1),size(ia,2)))
call gamx2d(ictxt,'A',dat,ria=ia,cia=cia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_iamxm
subroutine psb_damxs(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia
integer :: rt_
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
call gamx2d(ictxt,'A',dat,ria=ia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_damxs
subroutine psb_damxv(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia(:)
integer :: rt_
integer, allocatable :: cia(:)
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
allocate(cia(size(ia)))
call gamx2d(ictxt,'A',dat,ria=ia,cia=cia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_damxv
subroutine psb_damxm(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia(:,:)
integer :: rt_
integer, allocatable :: cia(:,:)
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
allocate(cia(size(ia,1),size(ia,2)))
call gamx2d(ictxt,'A',dat,ria=ia,cia=cia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_damxm
subroutine psb_zamxs(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia
integer :: rt_
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
call gamx2d(ictxt,'A',dat,ria=ia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_zamxs
subroutine psb_zamxv(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia(:)
integer :: rt_
integer, allocatable :: cia(:)
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
allocate(cia(size(ia)))
call gamx2d(ictxt,'A',dat,ria=ia,cia=cia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_zamxv
subroutine psb_zamxm(ictxt,dat,rt,ia)
integer, intent(in) :: ictxt
complex(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in), optional :: rt
integer, intent(inout), optional :: ia(:,:)
integer :: rt_
integer, allocatable :: cia(:,:)
if (present(rt)) then
rt_ = rt
else
rt_ = -1
endif
if (present(ia)) then
allocate(cia(size(ia,1),size(ia,2)))
call gamx2d(ictxt,'A',dat,ria=ia,cia=cia,rrt=rt_)
else
call gamx2d(ictxt,'A',dat,rrt=rt_)
endif
end subroutine psb_zamxm
!
!
!
!
!
!
!
subroutine igebs2ds(ictxt,scope,dat,top)
integer, intent(in) :: ictxt,dat

24
src/modules/psb_tools_mod.f90
Unescape Escape View File

@ -632,28 +632,4 @@ Module psb_tools_mod
end subroutine psb_cddec
end interface
interface psb_init
subroutine psb_init(ictxt,np)
integer, intent(out) :: ictxt
integer, intent(in), optional :: np
end subroutine psb_init
end interface
interface psb_exit
subroutine psb_exit(ictxt)
integer, intent(in) :: ictxt
end subroutine psb_exit
end interface
interface psb_info
subroutine psb_info(ictxt,iam,np)
integer, intent(in) :: ictxt
integer, intent(out) :: iam, np
end subroutine psb_info
end interface
interface psb_barrier
subroutine psb_barrier(ictxt)
integer, intent(in) :: ictxt
end subroutine psb_barrier
end interface
end module psb_tools_mod

3
src/tools/Makefile
Unescape Escape View File

@ -11,8 +11,7 @@ FOBJS = psb_dallc.o psb_dasb.o psb_dcsrp.o psb_cdprt.o \
psb_ifree.o psb_iins.o psb_loc_to_glob.o\
psb_zallc.o psb_zasb.o psb_zfree.o psb_zins.o \
psb_zspalloc.o psb_zspasb.o psb_zspcnv.o psb_zspfree.o\
psb_zspins.o psb_zsprn.o psb_zcdovr.o psb_zgelp.o\
psb_init.o psb_exit.o psb_info.o psb_barrier.o
psb_zspins.o psb_zsprn.o psb_zcdovr.o psb_zgelp.o
MPFOBJS = psb_dcdovrbld.o psb_dsphalo.o psb_zcdovrbld.o psb_zsphalo.o

6
src/tools/psb_barrier.f90
Unescape Escape View File

@ -1,6 +0,0 @@
subroutine psb_barrier(ictxt)
integer, intent(in) :: ictxt
call blacs_barrier(ictxt,'All')
end subroutine psb_barrier

12
src/tools/psb_exit.f90
Unescape Escape View File

@ -1,12 +0,0 @@
subroutine psb_exit(ictxt)
integer, intent(in) :: ictxt
integer :: nprow, npcol, myprow, mypcol
call blacs_gridinfo(ictxt, nprow, npcol, myprow, mypcol)
if ((myprow >=0).and.(mypcol>=0)) then
call blacs_gridexit(ictxt)
end if
call blacs_exit(0)
end subroutine psb_exit

11
src/tools/psb_info.f90
Unescape Escape View File

@ -1,11 +0,0 @@
subroutine psb_info(ictxt,iam,np)
integer, intent(in) :: ictxt
integer, intent(out) :: iam, np
integer :: nprow, npcol, myprow, mypcol
call blacs_gridinfo(ictxt, nprow, npcol, myprow, mypcol)
iam = myprow
np = nprow
end subroutine psb_info

31
src/tools/psb_init.f90
Unescape Escape View File

@ -1,31 +0,0 @@
subroutine psb_init(ictxt,np)
use psb_const_mod
use psb_blacs_mod
use psb_error_mod
integer, intent(out) :: ictxt
integer, intent(in), optional :: np
integer :: np_, npavail, iam, info
character(len=20), parameter :: name='psb_init'
call blacs_pinfo(iam, npavail)
call blacs_get(izero, izero, ictxt)
if (present(np)) then
np_ = max(1,min(np,npavail))
else
np_ = npavail
endif
call blacs_gridinit(ictxt, 'R', np_, ione)
if (present(np)) then
if (np_ < np) then
info = 2011
call psb_errpush(info,name)
call psb_error(ictxt)
endif
endif
end subroutine psb_init

6
test/Fileread/df_sample.f90
Unescape Escape View File

@ -216,7 +216,7 @@ program df_sample
t2 = mpi_wtime() - t1
call gamx2d(ictxt, 'a', t2)
call psb_amx(ictxt, t2)
if (amroot) then
write(*,'(" ")')
@ -262,7 +262,7 @@ program df_sample
end if
call gamx2d(ictxt,'a',tprec)
call psb_amx(ictxt, tprec)
if(amroot) then
write(*,'("Preconditioner time: ",es10.4)')tprec
@ -290,7 +290,7 @@ program df_sample
endif
call blacs_barrier(ictxt,'all')
t2 = mpi_wtime() - t1
call gamx2d(ictxt,'a',t2)
call psb_amx(ictxt,t2)
call psb_geaxpby(1.d0,b_col,0.d0,r_col,desc_a,info)
call psb_spmm(-1.d0,a,x_col,1.d0,r_col,desc_a,info)
call psb_genrm2s(resmx,r_col,desc_a,info)

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

@ -29,7 +29,7 @@
!!$
!!$
MODULE GETP
use psb_sparse_mod
PUBLIC GET_PARMS
PUBLIC PR_USAGE
@ -48,7 +48,7 @@ CONTAINS
INTEGER :: IARGC, NP, IAM
EXTERNAL IARGC
INTEGER :: INPARMS(40), IP
call psb_info(ictxt,iam,np)
IF (IAM==0) THEN
! Read Input Parameters
@ -64,20 +64,20 @@ CONTAINS
INPARMS(I) = IACHAR(MTRX_FILE(I:I))
END DO
! Broadcast parameters to all processors
CALL IGEBS2D(ICTXT,'ALL',' ',40,1,INPARMS,40)
call psb_bcast(ictxt,inparms(1:40),0)
! Convert strings in array
DO I = 1, LEN(CMETHD)
INPARMS(I) = IACHAR(CMETHD(I:I))
END DO
! Broadcast parameters to all processors
CALL IGEBS2D(ICTXT,'ALL',' ',40,1,INPARMS,40)
call psb_bcast(ictxt,inparms(1:40),0)
DO I = 1, LEN(AFMT)
INPARMS(I) = IACHAR(AFMT(I:I))
END DO
! Broadcast parameters to all processors
CALL IGEBS2D(ICTXT,'ALL',' ',40,1,INPARMS,40)
call psb_bcast(ictxt,inparms(1:40),0)
READ(*,*) IPART
IF (IP.GE.5) THEN
@ -118,50 +118,52 @@ CONTAINS
INPARMS(4) = ITRACE
INPARMS(5) = IPREC
INPARMS(6) = NOVR
CALL IGEBS2D(ICTXT,'ALL',' ',6,1,INPARMS,6)
CALL DGEBS2D(ICTXT,'ALL',' ',1,1,EPS,1)
call psb_bcast(ictxt,inparms(1:6),0)
call psb_bcast(ictxt,eps,0)
write(*,'("Solving matrix : ",a40)')mtrx_file
write(*,'("Number of processors : ",i3)')nprow
write(*,'("Data distribution : ",i2)')ipart
write(*,'("Preconditioner : ",i2)')iprec
if(iprec.gt.2) write(*,'("Overlapping levels : ",i2)')novr
write(*,'("Iterative method : ",a40)')cmethd
write(*,'("Storage format : ",a3)')afmt(1:3)
write(*,'(" ")')
write(*,'("Solving matrix : ",a40)')mtrx_file
write(*,'("Number of processors : ",i3)')nprow
write(*,'("Data distribution : ",i2)')ipart
write(*,'("Preconditioner : ",i2)')iprec
if(iprec.gt.2) write(*,'("Overlapping levels : ",i2)')novr
write(*,'("Iterative method : ",a40)')cmethd
write(*,'("Storage format : ",a3)')afmt(1:3)
write(*,'(" ")')
else
CALL PR_USAGE(0)
CALL BLACS_ABORT(ICTXT,-1)
STOP 1
END IF
ELSE
call pr_usage(0)
call psb_exit(ictxt)
stop 1
end if
else
! Receive Parameters
CALL IGEBR2D(ICTXT,'A',' ',40,1,INPARMS,40,0,0)
DO I = 1, 40
MTRX_FILE(I:I) = ACHAR(INPARMS(I))
END DO
CALL IGEBR2D(ICTXT,'A',' ',40,1,INPARMS,40,0,0)
call psb_bcast(ictxt,inparms(1:40),0)
do i = 1, 40
mtrx_file(i:i) = achar(inparms(i))
end do
call psb_bcast(ictxt,inparms(1:40),0)
DO I = 1, 40
CMETHD(I:I) = ACHAR(INPARMS(I))
END DO
CALL IGEBR2D(ICTXT,'A',' ',40,1,INPARMS,40,0,0)
call psb_bcast(ictxt,inparms(1:40),0)
DO I = 1, LEN(AFMT)
AFMT(I:I) = ACHAR(INPARMS(I))
END DO
CALL IGEBR2D(ICTXT,'A',' ',6,1,INPARMS,6,0,0)
IPART = INPARMS(1)
ISTOPC = INPARMS(2)
ITMAX = INPARMS(3)
ITRACE = INPARMS(4)
IPREC = INPARMS(5)
NOVR = INPARMS(6)
CALL DGEBR2D(ICTXT,'A',' ',1,1,EPS,1,0,0)
END IF
call psb_bcast(ictxt,inparms(1:6),0)
ipart = inparms(1)
istopc = inparms(2)
itmax = inparms(3)
itrace = inparms(4)
iprec = inparms(5)
novr = inparms(6)
call psb_bcast(ictxt,eps,0)
end if
END SUBROUTINE GET_PARMS
SUBROUTINE PR_USAGE(IOUT)
INTEGER IOUT

71
test/Fileread/mat_dist.f90
Unescape Escape View File

@ -165,17 +165,12 @@ contains
nnzero = size(a_glob%aspk)
nrhs = 1
! broadcast informations to other processors
call gebs2d(ictxt, 'a', nrow)
call gebs2d(ictxt, 'a', ncol)
call gebs2d(ictxt, 'a', nnzero)
call gebs2d(ictxt, 'a', nrhs)
else !(iam /= root)
! receive informations
call gebr2d(ictxt, 'a', nrow)
call gebr2d(ictxt, 'a', ncol)
call gebr2d(ictxt, 'a', nnzero)
call gebr2d(ictxt, 'a', nrhs)
end if ! allocate integer work area
endif
call psb_bcast(ictxt, nrow,root)
call psb_bcast(ictxt, ncol,root)
call psb_bcast(ictxt, nnzero,root)
call psb_bcast(ictxt, nrhs,root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
@ -597,18 +592,12 @@ contains
nnzero = size(a_glob%aspk)
nrhs = 1
! broadcast informations to other processors
call igebs2d(ictxt, 'a', ' ', 1, 1, nrow, 1)
call igebs2d(ictxt, 'a', ' ', 1, 1, ncol, 1)
call igebs2d(ictxt, 'a', ' ', 1, 1, nnzero, 1)
call igebs2d(ictxt, 'a', ' ', 1, 1, nrhs, 1)
else !(iam /= root)
! receive informations
call igebr2d(ictxt, 'a', ' ', 1, 1, nrow, 1, root, 0)
call igebr2d(ictxt, 'a', ' ', 1, 1, ncol, 1, root, 0)
call igebr2d(ictxt, 'a', ' ', 1, 1, nnzero, 1, root, 0)
call igebr2d(ictxt, 'a', ' ', 1, 1, nrhs, 1, root, 0)
end if ! allocate integer work area
end if
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
call psb_bcast(ictxt,ncol, root)
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
@ -947,18 +936,12 @@ contains
endif
nnzero = size(a_glob%aspk)
nrhs = 1
! broadcast informations to other processors
call gebs2d(ictxt, 'a', nrow)
call gebs2d(ictxt, 'a', ncol)
call gebs2d(ictxt, 'a', nnzero)
call gebs2d(ictxt, 'a', nrhs)
else !(iam /= root)
! receive informations
call gebr2d(ictxt, 'a', nrow)
call gebr2d(ictxt, 'a', ncol)
call gebr2d(ictxt, 'a', nnzero)
call gebr2d(ictxt, 'a', nrhs)
end if ! allocate integer work area
endif
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
call psb_bcast(ictxt,ncol, root)
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
@ -1380,18 +1363,12 @@ contains
nnzero = size(a_glob%aspk)
nrhs = 1
! broadcast informations to other processors
call gebs2d(ictxt, 'a', nrow)
call gebs2d(ictxt, 'a', ncol)
call gebs2d(ictxt, 'a', nnzero)
call gebs2d(ictxt, 'a', nrhs)
else !(iam /= root)
! receive informations
call gebr2d(ictxt, 'a', nrow)
call gebr2d(ictxt, 'a', ncol)
call gebr2d(ictxt, 'a', nnzero)
call gebr2d(ictxt, 'a', nrhs)
end if ! allocate integer work area
end if
! broadcast informations to other processors
call psb_bcast(ictxt,nrow, root)
call psb_bcast(ictxt,ncol, root)
call psb_bcast(ictxt,nnzero, root)
call psb_bcast(ictxt,nrhs, root)
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then

6
test/Fileread/zf_sample.f90
Unescape Escape View File

@ -217,7 +217,7 @@ program zf_sample
t2 = mpi_wtime() - t1
call gamx2d(ictxt, 'a', t2)
call psb_amx(ictxt, t2)
if (amroot) then
write(*,'(" ")')
@ -262,7 +262,7 @@ program zf_sample
end if
call gamx2d(ictxt,'a',tprec)
call psb_amx(ictxt,tprec)
if(amroot) then
write(*,'("Preconditioner time: ",es10.4)')tprec
@ -281,7 +281,7 @@ program zf_sample
endif
call blacs_barrier(ictxt,'all')
t2 = mpi_wtime() - t1
call gamx2d(ictxt,'a',t2)
call psb_amx(ictxt,t2)
call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info)
call psb_spmm(-zone,a,x_col,zone,r_col,desc_a,info)
call psb_genrm2s(resmx,r_col,desc_a,info)

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

@ -150,14 +150,14 @@ program pde90
goto 9999
end if
call gamx2d(ictxt,'a',t2)
if (iam.eq.0) write(*,'("Overall matrix creation time : ",es10.4)')t2
if (iam.eq.0) write(*,'(" ")')
call psb_amx(ictxt,t2)
if (iam == 0) write(*,'("Overall matrix creation time : ",es10.4)')t2
if (iam == 0) write(*,'(" ")')
!
! prepare the preconditioner.
!
if(iam.eq.psb_root_) write(0,'("Setting preconditioner to : ",a)')pr_to_str(iprec)
if(iam == psb_root_) write(0,'("Setting preconditioner to : ",a)')pr_to_str(iprec)
select case(iprec)
case(noprec_)
call psb_precset(pre,'noprec')
@ -189,28 +189,28 @@ program pde90
tprec = mpi_wtime()-t1
call gamx2d(ictxt,'a',tprec)
call psb_amx(ictxt,tprec)
if (iam.eq.0) write(*,'("Preconditioner time : ",es10.4)')tprec
if (iam.eq.0) write(*,'(" ")')
if (iam == 0) write(*,'("Preconditioner time : ",es10.4)')tprec
if (iam == 0) write(*,'(" ")')
!
! iterative method parameters
!
if(iam.eq.psb_root_) write(*,'("Calling iterative method ",a)')cmethd
if(iam == psb_root_) write(*,'("Calling iterative method ",a)')cmethd
call psb_barrier(ictxt)
t1 = mpi_wtime()
eps = 1.d-9
if (cmethd.eq.'BICGSTAB') then
if (cmethd == 'BICGSTAB') then
call psb_bicgstab(a,pre,b,x,eps,desc_a,info,&
& itmax,iter,err,itrace)
else if (cmethd.eq.'CGS') then
else if (cmethd == 'CGS') then
call psb_cgs(a,pre,b,x,eps,desc_a,info,&
& itmax,iter,err,itrace)
else if (cmethd.eq.'CG') then
else if (cmethd == 'CG') then
call psb_cg(a,pre,b,x,eps,desc_a,info,&
& itmax,iter,err,itrace)
else if (cmethd.eq.'BICGSTABL') then
else if (cmethd == 'BICGSTABL') then
call psb_bicgstabl(a,pre,b,x,eps,desc_a,info,&
& itmax,iter,err,itrace,ml)
else
@ -226,9 +226,9 @@ program pde90
call psb_barrier(ictxt)
t2 = mpi_wtime() - t1
call gamx2d(ictxt,'a',t2)
call psb_amx(ictxt,t2)
if (iam.eq.0) then
if (iam == 0) then
write(*,'(" ")')
write(*,'("Time to solve matrix : ",es10.4)')t2
write(*,'("Time per iteration : ",es10.4)')t2/iter
@ -287,19 +287,16 @@ contains
intbuf(i) = iachar(cmethd(i:i))
end do
! broadcast parameters to all processors
call igebs2d(ictxt,'ALL',' ',10,1,intbuf,10)
call psb_bcast(ictxt,intbuf(1:10),0)
! broadcast parameters to all processors
call igebs2d(ictxt,'ALL',' ',1,1,iprec,10)
! broadcast parameters to all processors
call igebs2d(ictxt,'ALL',' ',1,1,novr,10)
call psb_bcast(ictxt,iprec,0)
call psb_bcast(ictxt,novr,0)
do i = 1, len(afmt)
intbuf(i) = iachar(afmt(i:i))
end do
! broadcast parameters to all processors
call igebs2d(ictxt,'ALL',' ',10,1,intbuf,10)
call psb_bcast(ictxt,intbuf(1:10),0)
read(*,*) idim
if (ip.ge.4) then
@ -329,7 +326,7 @@ contains
intbuf(3) = itmax
intbuf(4) = itrace
intbuf(5) = ml
call igebs2d(ictxt,'ALL',' ',5,1,intbuf,5)
call psb_bcast(ictxt,intbuf(1:5),0)
write(*,'("Solving matrix : ell1")')
write(*,'("Grid dimensions : ",i4,"x",i4,"x",i4)')idim,idim,idim
@ -342,25 +339,23 @@ contains
else
! wrong number of parameter, print an error message and exit
call pr_usage(0)
call blacs_abort(ictxt,-1)
call psb_abort(ictxt)
stop 1
endif
else
! receive parameters
call igebr2d(ictxt,'ALL',' ',10,1,intbuf,10,0,0)
call psb_bcast(ictxt,intbuf(1:10),0)
do i = 1, 10
cmethd(i:i) = achar(intbuf(i))
end do
call igebr2d(ictxt,'ALL',' ',1,1,iprec,10,0,0)
call igebr2d(ictxt,'ALL',' ',1,1,novr,10,0,0)
call igebr2d(ictxt,'ALL',' ',10,1,intbuf,10,0,0)
call psb_bcast(ictxt,iprec,0)
call psb_bcast(ictxt,novr,0)
call psb_bcast(ictxt,intbuf(1:10),0)
do i = 1, 5
afmt(i:i) = achar(intbuf(i))
end do
call igebr2d(ictxt,'ALL',' ',5,1,intbuf,5,0,0)
call psb_bcast(ictxt,intbuf(1:5),0)
idim = intbuf(1)
istopc = intbuf(2)
itmax = intbuf(3)
@ -468,7 +463,7 @@ contains
m = idim*idim*idim
n = m
nnz = ((n*9)/(np))
if(iam.eq.psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n
if(iam == psb_root_) write(0,'("Generating Matrix (size=",i0x,")...")')n
call psb_cdall(n,n,parts,ictxt,desc_a,info)
call psb_spall(a,desc_a,info,nnz=nnz)
@ -510,12 +505,12 @@ contains
! local matrix pointer
element=1
! compute gridpoint coordinates
if (mod(glob_row,(idim*idim)).eq.0) then
if (mod(glob_row,(idim*idim)) == 0) then
x = glob_row/(idim*idim)
else
x = glob_row/(idim*idim)+1
endif
if (mod((glob_row-(x-1)*idim*idim),idim).eq.0) then
if (mod((glob_row-(x-1)*idim*idim),idim) == 0) then
y = (glob_row-(x-1)*idim*idim)/idim
else
y = (glob_row-(x-1)*idim*idim)/idim+1
@ -661,11 +656,11 @@ contains
goto 9999
end if
call gamx2d(ictxt,'a',t2)
call gamx2d(ictxt,'a',tins)
call gamx2d(ictxt,'a',tasb)
call psb_amx(ictxt,t2)
call psb_amx(ictxt,tins)
call psb_amx(ictxt,tasb)
if(iam.eq.psb_root_) then
if(iam == psb_root_) then
write(*,'("The matrix has been generated and assembeld in ",a3," format.")')a%fida(1:3)
write(*,'("-pspins time : ",es10.4)')tins
write(*,'("-insert time : ",es10.4)')t2
@ -686,7 +681,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
if (err_act == act_abort) then
call psb_error(ictxt)
return
end if

Write Preview
Loading…
Cancel
Save