From c56e74c0f0038c9bf5e48f027046a1d5ad193c04 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 29 May 2006 11:26:38 +0000 Subject: [PATCH] Added psblas interfaces to BLACS. Step 2: up to AMX --- Make.inc | 6 +- src/modules/Makefile | 1 + src/modules/psb_blacs_mod.f90 | 461 ++++++++++++++++++++++++++++++++++ src/modules/psb_tools_mod.f90 | 24 -- src/tools/Makefile | 3 +- src/tools/psb_barrier.f90 | 6 - src/tools/psb_exit.f90 | 12 - src/tools/psb_info.f90 | 11 - src/tools/psb_init.f90 | 31 --- test/Fileread/df_sample.f90 | 6 +- test/Fileread/getp.f90 | 78 +++--- test/Fileread/mat_dist.f90 | 71 ++---- test/Fileread/zf_sample.f90 | 6 +- test/pargen/ppde90.f90 | 73 +++--- 14 files changed, 570 insertions(+), 219 deletions(-) delete mode 100644 src/tools/psb_barrier.f90 delete mode 100644 src/tools/psb_exit.f90 delete mode 100644 src/tools/psb_info.f90 delete mode 100644 src/tools/psb_init.f90 diff --git a/Make.inc b/Make.inc index 12ecdc1b..46ecd6ea 100644 --- a/Make.inc +++ b/Make.inc @@ -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 # diff --git a/src/modules/Makefile b/src/modules/Makefile index 1cf62f73..bb49858b 100644 --- a/src/modules/Makefile +++ b/src/modules/Makefile @@ -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) diff --git a/src/modules/psb_blacs_mod.f90 b/src/modules/psb_blacs_mod.f90 index 0fd1388f..ea0273df 100644 --- a/src/modules/psb_blacs_mod.f90 +++ b/src/modules/psb_blacs_mod.f90 @@ -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 diff --git a/src/modules/psb_tools_mod.f90 b/src/modules/psb_tools_mod.f90 index 0efd7f8d..0ae51997 100644 --- a/src/modules/psb_tools_mod.f90 +++ b/src/modules/psb_tools_mod.f90 @@ -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 diff --git a/src/tools/Makefile b/src/tools/Makefile index f190a576..891125d9 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -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 diff --git a/src/tools/psb_barrier.f90 b/src/tools/psb_barrier.f90 deleted file mode 100644 index 58ef1ca8..00000000 --- a/src/tools/psb_barrier.f90 +++ /dev/null @@ -1,6 +0,0 @@ -subroutine psb_barrier(ictxt) - integer, intent(in) :: ictxt - - call blacs_barrier(ictxt,'All') - -end subroutine psb_barrier diff --git a/src/tools/psb_exit.f90 b/src/tools/psb_exit.f90 deleted file mode 100644 index 2f9a6eb6..00000000 --- a/src/tools/psb_exit.f90 +++ /dev/null @@ -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 diff --git a/src/tools/psb_info.f90 b/src/tools/psb_info.f90 deleted file mode 100644 index cdac56c8..00000000 --- a/src/tools/psb_info.f90 +++ /dev/null @@ -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 diff --git a/src/tools/psb_init.f90 b/src/tools/psb_init.f90 deleted file mode 100644 index 0f3dec22..00000000 --- a/src/tools/psb_init.f90 +++ /dev/null @@ -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 diff --git a/test/Fileread/df_sample.f90 b/test/Fileread/df_sample.f90 index 70888f95..211c6505 100644 --- a/test/Fileread/df_sample.f90 +++ b/test/Fileread/df_sample.f90 @@ -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) diff --git a/test/Fileread/getp.f90 b/test/Fileread/getp.f90 index 028505b0..85b26b89 100644 --- a/test/Fileread/getp.f90 +++ b/test/Fileread/getp.f90 @@ -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 diff --git a/test/Fileread/mat_dist.f90 b/test/Fileread/mat_dist.f90 index f0ff6bf9..bc7441e2 100644 --- a/test/Fileread/mat_dist.f90 +++ b/test/Fileread/mat_dist.f90 @@ -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 diff --git a/test/Fileread/zf_sample.f90 b/test/Fileread/zf_sample.f90 index 7cf3f8be..05e6b9f6 100644 --- a/test/Fileread/zf_sample.f90 +++ b/test/Fileread/zf_sample.f90 @@ -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) diff --git a/test/pargen/ppde90.f90 b/test/pargen/ppde90.f90 index 290a6917..91a7ee5e 100644 --- a/test/pargen/ppde90.f90 +++ b/test/pargen/ppde90.f90 @@ -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