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

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              #

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)

src/modules/psb_blacs_mod.f90

@@ -75,8 +75,469 @@ module psb_blacs_mod
   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
     character, intent(in) :: scope

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

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
 

src/tools/psb_barrier.f90

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

src/tools/psb_exit.f90

@@ -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

src/tools/psb_info.f90

@@ -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

src/tools/psb_init.f90

@@ -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

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)

test/Fileread/getp.f90

@@ -29,7 +29,7 @@
 !!$ 
 !!$  
 MODULE GETP
-
+  use psb_sparse_mod
   PUBLIC GET_PARMS
   PUBLIC PR_USAGE
 
@@ -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,49 +118,51 @@ 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 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)
 
-      CALL IGEBR2D(ICTXT,'A',' ',40,1,INPARMS,40,0,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)
+      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)
 
-      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
+    end if
 
   END SUBROUTINE GET_PARMS
   SUBROUTINE PR_USAGE(IOUT)

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

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)

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