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

Reorganization of test dir.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 7a3e36db56
commit 0383e80618
26 changed files with 114 additions and 3537 deletions
Show Stats Download Patch File Download Diff File

66
test/Fileread/Makefile
Unescape Escape View File

@ -1,66 +0,0 @@
include ../../Make.inc
#
# Libraries used
#
LIBDIR=../../lib/
PSBLAS_LIB= -L$(LIBDIR) -lpsblas
#
# We are using the public domain tool METIS from U. Minnesota. To get it
# check URL http://www.cs.umn.edu:~karypis
#
METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
INCDIRS=-I$(LIBDIR)
DFOBJS=partgraph.o part_block.o read_mat.o getp.o \
mmio.o mat_dist.o df_sample.o part_blk2.o
ZFOBJS=partgraph.o part_block.o read_mat.o getp.o \
mmio.o mat_dist.o zf_sample.o part_blk2.o
IOOBJS= mmio.o hbio.o
ZH2MOBJS=zhb2mm.o $(IOOBJS)
DH2MOBJS=dhb2mm.o $(IOOBJS)
DM2HOBJS=dmm2hb.o $(IOOBJS)
ZM2HOBJS=zmm2hb.o $(IOOBJS)
MMHBOBJS=zhb2mm.o dhb2mm.o dmm2hb.o zmm2hb.o
EXEDIR=./RUNS
all: df_sample zf_sample dhb2mm zhb2mm dmm2hb zmm2hb
read_mat.o: mmio.o
df_sample: $(DFOBJS)
$(F90LINK) $(LINKOPT) $(DFOBJS) -o df_sample\
$(PSBLAS_LIB) $(METIS_LIB) $(BLACS) $(SLU) $(UMF) $(BLAS)
/bin/mv df_sample $(EXEDIR)
zf_sample: $(ZFOBJS)
$(F90LINK) $(LINKOPT) $(ZFOBJS) -o zf_sample\
$(PSBLAS_LIB) $(METIS_LIB) $(BLACS) $(SLU) $(UMF) $(BLAS)
/bin/mv zf_sample $(EXEDIR)
$(MMHBOBJS): $(IOOBJS)
dhb2mm: $(DH2MOBJS)
$(MPF90) -o dhb2mm $(DH2MOBJS) $(PSBLAS_LIB) $(BLACS)
dmm2hb: $(DM2HOBJS)
$(MPF90) -o dmm2hb $(DM2HOBJS) $(PSBLAS_LIB) $(BLACS)
zhb2mm: $(ZH2MOBJS)
$(MPF90) -o zhb2mm $(ZH2MOBJS) $(PSBLAS_LIB) $(BLACS)
zmm2hb: $(ZM2HOBJS)
$(MPF90) -o zmm2hb $(ZM2HOBJS) $(PSBLAS_LIB) $(BLACS)
srctst: srctst.o
$(MPF90) -o srctst srctst.o $(PSBLAS_LIB) $(BLACS)
.f90.o:
$(MPF90) $(F90COPT) $(INCDIRS) -c $<
clean:
/bin/rm -f $(DFOBJS) $(ZFOBJS) $(IOOBJS) $(MMHBOBJS) \
*$(.mod) $(EXEDIR)/df_sample $(EXEDIR)/zf_sample dhb2mm zhb2mm dmm2hb zmm2hb
lib:
(cd ../../; make library)
verycleanlib:
(cd ../../; make veryclean)

638
test/Fileread/hbio.f90
Unescape Escape View File

@ -1,638 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
module hbio
use psb_sparse_mod
public hb_read, hb_write
interface hb_read
module procedure dhb_read, zhb_read
end interface
interface hb_write
module procedure dhb_write,zhb_write
end interface
contains
subroutine dhb_read(a, iret, iunit, filename,b,mtitle)
use psb_sparse_mod
implicit none
type(psb_dspmat_type), intent(out) :: a
integer, intent(out) :: iret
integer, optional, intent(in) :: iunit
character(len=*), optional, intent(in) :: filename
real(kind(1.d0)), optional, pointer :: b(:)
character(len=72), optional, intent(out) :: mtitle
character :: rhstype,type*3,key*8
character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
integer :: indcrd, ptrcrd, totcrd,&
& valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
integer :: ircode, i,iel,ptr,nzr,infile, j, info
character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
character(len=*), parameter :: fmt11='(a1,13x,2i14)'
character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
logical, parameter :: debug=.false.
iret = 0
if (present(filename)) then
if (filename=='-') then
infile=5
else
if (present(iunit)) then
infile=iunit
else
infile=99
endif
open(infile,file=filename, status='OLD', err=901, action='READ')
endif
else
if (present(iunit)) then
infile=iunit
else
infile=5
endif
endif
read (infile,fmt=fmt10) mtitle,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
& type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
if (rhscrd.gt.0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode)
if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed'
goto 993
end if
a%m = nrow
a%k = ncol
a%fida = 'CSR'
a%descra='G'
if (tolower(type(1:1)) == 'r') then
if (tolower(type(2:2)) == 'u') then
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (present(b) .and. (rhscrd.gt.0)) then
if (associated(b)) then
if (size(b) < nrow) deallocate(b)
endif
if (.not.associated(b)) then
allocate(b(nrow),stat=info)
endif
read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
else if (tolower(type(2:2)) == 's') then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (present(b) .and. (rhscrd.gt.0)) then
if (associated(b)) then
if (size(b) < nrow) deallocate(b)
endif
if (.not.associated(b)) then
allocate(b(nrow),stat=info)
endif
read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
call psb_ipcsr2coo(a,ircode)
if (ircode /= 0) goto 993
call psb_sp_reall(a,2*nnzero,ircode)
! A is now in COO format
nzr = nnzero
do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then
nzr = nzr + 1
a%aspk(nzr) = a%aspk(i)
a%ia1(nzr) = a%ia2(i)
a%ia2(nzr) = a%ia1(i)
end if
end do
a%infoa(psb_nnz_) = nzr
call psb_ipcoo2csr(a,ircode)
if (ircode /= 0) goto 993
else
write(0,*) 'read_matrix: matrix type not yet supported'
iret=904
end if
else
write(0,*) 'read_matrix: matrix type not yet supported'
iret=904
end if
if (infile/=5) close(infile)
return
! open failed
901 iret=901
write(0,*) 'read_matrix: could not open file ',filename,' for input'
return
902 iret=902
write(0,*) 'DHB_READ: Unexpected end of file '
return
993 iret=993
write(0,*) 'DHB_READ: Memory allocation failure'
return
end subroutine dhb_read
subroutine dhb_write(a,iret,eiout,filename,key,rhs,mtitle)
use psb_sparse_mod
implicit none
type(psb_dspmat_type), intent(in) :: a
integer, intent(out) :: iret
character(len=*), optional, intent(in) :: mtitle
integer, optional, intent(in) :: eiout
character(len=*), optional, intent(in) :: filename
character(len=*), optional, intent(in) :: key
real(kind(1.d0)), optional :: rhs(:)
integer :: iout
character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)'
integer, parameter :: jptr=10,jind=10
character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)'
integer, parameter :: jval=4,jrhs=4
character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
character(len=*), parameter :: fmt11='(a1,13x,2i14)'
character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
character(len=72) :: mtitle_
character(len=8) :: key_
character :: rhstype,type*3
integer :: i,indcrd,nrhsvl,ptrcrd,rhscrd,totcrd,valcrd,&
& nrow,ncol,nnzero, neltvl, nrhs, nrhsix
iret = 0
if (present(filename)) then
if (filename=='-') then
iout=6
else
if (present(eiout)) then
iout = eiout
else
iout=99
endif
open(iout,file=filename, err=901, action='WRITE')
endif
else
if (present(eiout)) then
iout = eiout
else
iout=6
endif
endif
if (present(mtitle)) then
mtitle_ = mtitle
else
mtitle_ = 'Temporary PSBLAS title '
endif
if (present(key)) then
key_ = key
else
key_ = 'PSBMAT00'
endif
if (toupper(a%fida) == 'CSR') then
nrow = a%m
ncol = a%k
nnzero = a%ia2(nrow+1)-1
neltvl = 0
ptrcrd = (nrow+1)/jptr
if (mod(nrow+1,jptr).gt.0) ptrcrd = ptrcrd + 1
indcrd = nnzero/jind
if (mod(nnzero,jind).gt.0) indcrd = indcrd + 1
valcrd = nnzero/jval
if (mod(nnzero,jval).gt.0) valcrd = valcrd + 1
if (present(rhs)) then
if (size(rhs)<nrow) then
rhscrd = 0
else
rhscrd = nrow/jrhs
if (mod(nrow,jrhs).gt.0) rhscrd = rhscrd + 1
endif
nrhs = 1
else
rhscrd = 0
nrhs = 0
end if
totcrd = ptrcrd + indcrd + valcrd + rhscrd
nrhsix = nrhs*nrow
rhstype = 'F'
type = 'RUA'
write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
& type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
if (rhscrd.gt.0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
write (iout,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
write (iout,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) write (iout,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (rhscrd.gt.0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
else
write(0,*) 'format: ',a%fida,' not yet implemented'
endif
if (iout /= 6) close(iout)
return
901 continue
iret=901
write(0,*) 'Error while opening ',filename
return
end subroutine dhb_write
subroutine zhb_read(a, iret, iunit, filename,b,mtitle)
use psb_sparse_mod
implicit none
type(psb_zspmat_type), intent(out) :: a
integer, intent(out) :: iret
integer, optional, intent(in) :: iunit
character(len=*), optional, intent(in) :: filename
real(kind(1.d0)), optional, pointer :: b(:)
character(len=72), optional, intent(out) :: mtitle
character :: rhstype,type*3,key*8
character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20
integer :: indcrd, ptrcrd, totcrd,&
& valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix
integer :: ircode, i,iel,ptr,nzr,infile,j, info
character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
character(len=*), parameter :: fmt11='(a1,13x,2i14)'
character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
logical, parameter :: debug=.false.
iret = 0
if (present(filename)) then
if (filename=='-') then
infile=5
else
if (present(iunit)) then
infile=iunit
else
infile=99
endif
open(infile,file=filename, status='OLD', err=901, action='READ')
endif
else
if (present(iunit)) then
infile=iunit
else
infile=5
endif
endif
read (infile,fmt=fmt10) mtitle,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
& type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
if (rhscrd.gt.0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix
if (tolower(type(1:1)) == 'c') then
if (tolower(type(2:2)) == 'u') then
call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode)
if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed'
goto 993
end if
a%m = nrow
a%k = ncol
a%fida = 'CSR'
a%descra='G'
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (present(b) .and. (rhscrd.gt.0)) then
if (associated(b)) then
if (size(b) < nrow) deallocate(b)
endif
if (.not.associated(b)) then
allocate(b(nrow),stat=info)
endif
read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
else if (tolower(type(2:2)) == 's') then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,nnzero,ircode)
if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed'
goto 993
end if
a%fida = 'CSR'
a%descra='G'
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (present(b) .and. (rhscrd.gt.0)) then
if (associated(b)) then
if (size(b) < nrow) deallocate(b)
endif
if (.not.associated(b)) then
allocate(b(nrow),stat=info)
endif
read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
call psb_ipcsr2coo(a,ircode)
if (ircode /= 0) then
write(0,*) 'ipcsr2coo ',ircode
goto 993
end if
call psb_sp_reall(a,2*nnzero,ircode)
if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed'
goto 993
end if
! A is now in COO format
nzr = nnzero
do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then
nzr = nzr + 1
a%aspk(nzr) = a%aspk(i)
a%ia1(nzr) = a%ia2(i)
a%ia2(nzr) = a%ia1(i)
end if
end do
a%infoa(psb_nnz_) = nzr
call psb_ipcoo2csr(a,ircode)
if (ircode /= 0) then
write(0,*) 'ipcoo2csr ',ircode
goto 993
end if
else if (tolower(type(2:2)) == 'h') then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed'
goto 993
end if
a%fida = 'CSR'
a%descra='G'
read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (present(b) .and. (rhscrd.gt.0)) then
if (associated(b)) then
if (size(b) < nrow) deallocate(b)
endif
if (.not.associated(b)) then
allocate(b(nrow),stat=info)
endif
read (infile,fmt=rhsfmt) (b(i),i=1,nrow)
endif
call psb_ipcsr2coo(a,ircode)
if (ircode /= 0) then
write(0,*) 'ipcsr2coo ',ircode
goto 993
end if
call psb_sp_reall(a,2*nnzero,ircode)
if (ircode /= 0 ) then
write(0,*) 'Memory allocation failed'
goto 993
end if
! A is now in COO format
nzr = nnzero
do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then
nzr = nzr + 1
a%aspk(nzr) = conjg(a%aspk(i))
a%ia1(nzr) = a%ia2(i)
a%ia2(nzr) = a%ia1(i)
end if
end do
a%infoa(psb_nnz_) = nzr
call psb_ipcoo2csr(a,ircode)
if (ircode /= 0) then
write(0,*) 'ipcoo2csr ',ircode
goto 993
end if
else
write(0,*) 'read_matrix: matrix type not yet supported'
iret=904
end if
else
write(0,*) 'read_matrix: matrix type not yet supported'
iret=904
end if
if (infile/=5) close(infile)
return
! open failed
901 iret=901
write(0,*) 'read_matrix: could not open file ',filename,' for input'
return
902 iret=902
write(0,*) 'ZHB_READ: Unexpected end of file '
return
993 iret=993
write(0,*) 'ZHB_READ: Memory allocation failure'
return
end subroutine zhb_read
subroutine zhb_write(a,iret,eiout,filename,key,rhs,mtitle)
use psb_sparse_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
integer, intent(out) :: iret
character(len=*), optional, intent(in) :: mtitle
integer, optional, intent(in) :: eiout
character(len=*), optional, intent(in) :: filename
character(len=*), optional, intent(in) :: key
complex(kind(1.d0)), optional :: rhs(:)
integer :: iout
character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)'
integer, parameter :: jptr=10,jind=10
character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)'
integer, parameter :: jval=4,jrhs=4
character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)'
character(len=*), parameter :: fmt11='(a1,13x,2i14)'
character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)'
character(len=72) :: mtitle_
character(len=8) :: key_
character :: rhstype,type*3
integer :: i,indcrd,nrhsvl,ptrcrd,rhscrd,totcrd,valcrd,&
& nrow,ncol,nnzero, neltvl,nrhs,nrhsix
iret = 0
if (present(filename)) then
if (filename=='-') then
iout=6
else
if (present(eiout)) then
iout = eiout
else
iout=99
endif
open(iout,file=filename, err=901, action='WRITE')
endif
else
if (present(eiout)) then
iout = eiout
else
iout=6
endif
endif
if (present(mtitle)) then
mtitle_ = mtitle
else
mtitle_ = 'Temporary PSBLAS title '
endif
if (present(key)) then
key_ = key
else
key_ = 'PSBMAT00'
endif
if (toupper(a%fida) == 'CSR') then
nrow = a%m
ncol = a%k
nnzero = a%ia2(nrow+1)-1
neltvl = 0
ptrcrd = (nrow+1)/jptr
if (mod(nrow+1,jptr).gt.0) ptrcrd = ptrcrd + 1
indcrd = nnzero/jind
if (mod(nnzero,jind).gt.0) indcrd = indcrd + 1
valcrd = nnzero/jval
if (mod(nnzero,jval).gt.0) valcrd = valcrd + 1
if (present(rhs)) then
if (size(rhs)<nrow) then
rhscrd = 0
else
rhscrd = nrow/jrhs
if (mod(nrow,jrhs).gt.0) rhscrd = rhscrd + 1
endif
nrhs = 1
else
rhscrd = 0
nrhs = 0
end if
totcrd = ptrcrd + indcrd + valcrd + rhscrd
nrhsix = nrhs * nrow
rhstype='F'
type='CUA'
write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,&
& type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt
if (rhscrd.gt.0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix
write (iout,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1)
write (iout,fmt=indfmt) (a%ia1(i),i=1,nnzero)
if (valcrd.gt.0) write (iout,fmt=valfmt) (a%aspk(i),i=1,nnzero)
if (rhscrd.gt.0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow)
else
write(0,*) 'format: ',a%fida,' not yet implemented'
endif
if (iout /= 6) close(iout)
return
901 continue
iret=901
write(0,*) 'Error while opening ',filename
return
end subroutine zhb_write
end module hbio

1584
test/Fileread/mat_dist.f90
View File

File diff suppressed because it is too large Load Diff

379
test/Fileread/mmio.f90
Unescape Escape View File

@ -1,379 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
module mmio
use psb_sparse_mod
public mm_mat_read, mm_mat_write
interface mm_mat_read
module procedure dmm_mat_read, zmm_mat_read
end interface
interface mm_mat_write
module procedure dmm_mat_write,zmm_mat_write
end interface
contains
subroutine dmm_mat_read(a, iret, iunit, filename)
use psb_sparse_mod
implicit none
type(psb_dspmat_type), intent(out) :: a
integer, intent(out) :: iret
integer, optional, intent(in) :: iunit
character(len=*), optional, intent(in) :: filename
character :: mmheader*15, fmt*15, object*10, type*10, sym*15
character(1024) :: line
integer :: nrow, ncol, nnzero, neltvl, nrhs, nrhsix
integer :: ircode, i,iel,nzr,infile, j
logical, parameter :: debug=.false.
iret = 0
if (present(filename)) then
if (filename=='-') then
infile=5
else
if (present(iunit)) then
infile=iunit
else
infile=99
endif
open(infile,file=filename, status='OLD', err=901, action='READ')
endif
else
if (present(iunit)) then
infile=iunit
else
infile=5
endif
endif
read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym
if ( (tolower(object) /= 'matrix').or.(tolower(fmt)/='coordinate')) then
write(0,*) 'READ_MATRIX: input file type not yet supported'
iret=909
return
end if
if (debug) write(*,*) mmheader,':', object, ':',fmt,':', type,':', sym
do
read(infile,fmt='(a)') line
if (line(1:1) /= '%') exit
end do
if (debug) write(*,*) 'Line on input : "',line,'"'
read(line,fmt=*) nrow,ncol,nnzero
if (debug) write(*,*) 'Out: ',nrow,ncol,nnzero
if ((tolower(type) == 'real').and.(tolower(sym) == 'general')) then
call psb_sp_all(nrow,ncol,a,nnzero,ircode)
a%fida = 'COO'
a%descra = 'G'
if (ircode /= 0) goto 993
do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),a%aspk(i)
end do
a%infoa(psb_nnz_) = nnzero
call psb_ipcoo2csr(a,ircode)
else if ((tolower(type) == 'real').and.(tolower(sym) == 'symmetric')) then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
a%fida = 'COO'
a%descra = 'G'
if (ircode /= 0) goto 993
do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),a%aspk(i)
end do
nzr = nnzero
do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then
nzr = nzr + 1
a%aspk(nzr) = a%aspk(i)
a%ia1(nzr) = a%ia2(i)
a%ia2(nzr) = a%ia1(i)
end if
end do
a%infoa(psb_nnz_) = nzr
call psb_ipcoo2csr(a,ircode)
else
write(0,*) 'read_matrix: matrix type not yet supported'
iret=904
end if
if (infile/=5) close(infile)
return
! open failed
901 iret=901
write(0,*) 'read_matrix: could not open file ',filename,' for input'
return
902 iret=902
write(0,*) 'READ_MATRIX: Unexpected end of file '
return
993 iret=993
write(0,*) 'READ_MATRIX: Memory allocation failure'
return
end subroutine dmm_mat_read
subroutine dmm_mat_write(a,mtitle,iret,eiout,filename)
use psb_sparse_mod
implicit none
type(psb_dspmat_type), intent(in) :: a
integer, intent(out) :: iret
character(len=*), intent(in) :: mtitle
integer, optional, intent(in) :: eiout
character(len=*), optional, intent(in) :: filename
integer :: iout
iret = 0
if (present(filename)) then
if (filename=='-') then
iout=6
else
if (present(eiout)) then
iout = eiout
else
iout=99
endif
open(iout,file=filename, err=901, action='WRITE')
endif
else
if (present(eiout)) then
iout = eiout
else
iout=6
endif
endif
call psb_csprt(iout,a,head=mtitle)
if (iout /= 6) close(iout)
return
901 continue
iret=901
write(0,*) 'Error while opening ',filename
return
end subroutine dmm_mat_write
subroutine zmm_mat_read(a, iret, iunit, filename)
use psb_sparse_mod
implicit none
type(psb_zspmat_type), intent(out) :: a
integer, intent(out) :: iret
integer, optional, intent(in) :: iunit
character(len=*), optional, intent(in) :: filename
character :: mmheader*15, fmt*15, object*10, type*10, sym*15
character(1024) :: line
integer :: nrow, ncol, nnzero, neltvl, nrhs, nrhsix
integer :: ircode, i,iel,nzr,infile,j
real(kind(1.d0)) :: are, aim
logical, parameter :: debug=.false.
iret = 0
if (present(filename)) then
if (filename=='-') then
infile=5
else
if (present(iunit)) then
infile=iunit
else
infile=99
endif
open(infile,file=filename, status='OLD', err=901, action='READ')
endif
else
if (present(iunit)) then
infile=iunit
else
infile=5
endif
endif
read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym
if ( (tolower(object) /= 'matrix').or.(tolower(fmt)/='coordinate')) then
write(0,*) 'READ_MATRIX: input file type not yet supported'
iret=909
return
end if
if (debug) write(*,*) mmheader,':', object, ':',fmt,':', type,':', sym
do
read(infile,fmt='(a)') line
if (line(1:1) /= '%') exit
end do
if (debug) write(*,*) 'Line on input : "',line,'"'
read(line,fmt=*) nrow,ncol,nnzero
if (debug) write(*,*) 'Out: ',nrow,ncol,nnzero
if ((tolower(type) == 'complex').and.(tolower(sym) == 'general')) then
call psb_sp_all(nrow,ncol,a,nnzero,ircode)
if (ircode /= 0) goto 993
a%fida = 'COO'
a%descra = 'G'
do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim
a%aspk(i) = cmplx(are,aim)
end do
a%infoa(psb_nnz_) = nnzero
call psb_ipcoo2csr(a,ircode)
else if ((tolower(type) == 'complex').and.(tolower(sym) == 'symmetric')) then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
if (ircode /= 0) goto 993
a%fida = 'COO'
a%descra = 'G'
do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim
a%aspk(i) = cmplx(are,aim)
end do
nzr = nnzero
do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then
nzr = nzr + 1
a%aspk(nzr) = a%aspk(i)
a%ia1(nzr) = a%ia2(i)
a%ia2(nzr) = a%ia1(i)
end if
end do
a%infoa(psb_nnz_) = nzr
call psb_ipcoo2csr(a,ircode)
else if ((tolower(type) == 'complex').and.(tolower(sym) == 'hermitian')) then
! we are generally working with non-symmetric matrices, so
! we de-symmetrize what we are about to read
call psb_sp_all(nrow,ncol,a,2*nnzero,ircode)
if (ircode /= 0) goto 993
a%fida = 'COO'
a%descra = 'G'
do i=1,nnzero
read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim
a%aspk(i) = cmplx(are,aim)
end do
nzr = nnzero
do i=1,nnzero
if (a%ia1(i) /= a%ia2(i)) then
nzr = nzr + 1
a%aspk(nzr) = conjg(a%aspk(i))
a%ia1(nzr) = a%ia2(i)
a%ia2(nzr) = a%ia1(i)
end if
end do
a%infoa(psb_nnz_) = nzr
call psb_ipcoo2csr(a,ircode)
else
write(0,*) 'read_matrix: matrix type not yet supported'
iret=904
end if
if (infile/=5) close(infile)
return
! open failed
901 iret=901
write(0,*) 'read_matrix: could not open file ',filename,' for input'
return
902 iret=902
write(0,*) 'READ_MATRIX: Unexpected end of file '
return
993 iret=993
write(0,*) 'READ_MATRIX: Memory allocation failure'
return
end subroutine zmm_mat_read
subroutine zmm_mat_write(a,mtitle,iret,eiout,filename)
use psb_sparse_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
integer, intent(out) :: iret
character(len=*), intent(in) :: mtitle
integer, optional, intent(in) :: eiout
character(len=*), optional, intent(in) :: filename
integer :: iout
iret = 0
if (present(filename)) then
if (filename=='-') then
iout=6
else
if (present(eiout)) then
iout = eiout
else
iout=99
endif
open(iout,file=filename, err=901, action='WRITE')
endif
else
if (present(eiout)) then
iout = eiout
else
iout=6
endif
endif
call psb_csprt(iout,a,head=mtitle)
if (iout /= 6) close(iout)
return
901 continue
iret=901
write(0,*) 'Error while opening ',filename
return
end subroutine zmm_mat_write
end module mmio

86
test/Fileread/part_blk2.f
Unescape Escape View File

@ -1,86 +0,0 @@
C
C Parallel Sparse BLAS v2.0
C (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
C
C User defined function corresponding to an HPF BLOCK partition
C
SUBROUTINE PART_BLK2(IDX,N,NP,PV,NV)
IMPLICIT NONE
INTEGER IDX, N, NP
INTEGER NV
INTEGER PV(*)
DOUBLE PRECISION DDIFF
INTEGER IB1, IB2, IP, NB, NB1, NNB1
NV = 1
NB = N/NP
NB1 = NB+1
NNB1 = MOD(N,NP)
IF (IDX .LE. (NNB1*NB1)) THEN
PV(1) = (IDX - 1) / NB1
ELSE
IF (NB > 0) THEN
IP = ( (IDX-NNB1*NB1) - 1)/NB
PV(1) = NNB1 + IP
ELSE
write(0,*) 'Impossible ??? '
PV(1) = NNB1
ENDIF
ENDIF
RETURN
END
SUBROUTINE BLD_PARTBLK2(N,NP,IVG)
INTEGER N, IVG(*),NP
INTEGER IB1, IB2, IP, NB, NB1, NNB1, I
NB = N/NP
NB1 = NB+1
NNB1 = MOD(N,NP)
DO I=1,N
IF (I .LE. (NNB1*NB1)) THEN
IVG(I) = (I - 1) / NB1
ELSE
IF (NB > 0) THEN
IP = ( (I-NNB1*NB1) - 1)/NB
IVG(I) = NNB1 + IP
ELSE
write(0,*) 'Impossible ??? '
IVG(I) = NNB1
ENDIF
ENDIF
ENDDO
END

97
test/Fileread/part_block.f
Unescape Escape View File

@ -1,97 +0,0 @@
C
C Parallel Sparse BLAS v2.0
C (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
C
C User defined function corresponding to an HPF BLOCK partition
C
SUBROUTINE PART_BLOCK(GLOBAL_INDX,N,NP,PV,NV)
IMPLICIT NONE
INTEGER GLOBAL_INDX, N, NP
INTEGER NV
INTEGER PV(*)
INTEGER DIM_BLOCK
DOUBLE PRECISION DDIFF
INTEGER IB1, IB2, IPV
double precision PC
PARAMETER (PC=0.0D0)
DIM_BLOCK = (N + NP - 1)/NP
NV = 1
PV(NV) = (GLOBAL_INDX - 1) / DIM_BLOCK
IPV = PV(1)
IB1 = IPV * DIM_BLOCK + 1
IB2 = (IPV+1) * DIM_BLOCK
DDIFF = DBLE(ABS(GLOBAL_INDX-IB1))/DBLE(DIM_BLOCK)
IF (DDIFF .lt. PC/2) THEN
C
C Overlap at the beginning of a block, with the previous proc
C
IF (IPV.gt.0) THEN
NV = NV + 1
PV(NV) = IPV - 1
ENDIF
ENDIF
DDIFF = DBLE(ABS(GLOBAL_INDX-IB2))/DBLE(DIM_BLOCK)
IF (DDIFF .lt. PC/2) THEN
C
C Overlap at the end of a block, with the next proc
C
IF (IPV.lt.(NP-1)) THEN
NV = NV + 1
PV(NV) = IPV + 1
ENDIF
ENDIF
RETURN
END
SUBROUTINE BLD_PARTBLOCK(N,NP,IVG)
INTEGER N,NP,IVG(*)
INTEGER DIM_BLOCK,I
DIM_BLOCK = (N + NP - 1)/NP
DO I=1,N
IVG(I) = (I - 1) / DIM_BLOCK
ENDDO
END

222
test/Fileread/partgraph.f90
Unescape Escape View File

@ -1,222 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! Purpose:
! Provide a set of subroutines to define a data distribution based on
! a graph partitioning routine.
!
! Subroutines:
!
! BUILD_GRPPART(A,NPARTS): This subroutine will be called by the root
! process to build define the data distribuition mapping.
! Input parameters:
! TYPE(D_SPMAT) :: A The input matrix. The coefficients are
! ignored; only the structure is used.
! INTEGER :: NPARTS How many parts we are requiring to the
! partition utility
!
! DISTR_GRPPART(RROOT,CROOT,ICTXT): This subroutine will be called by
! all processes to distribute the information computed by the root
! process, to be used subsequently.
!
!
! PART_GRAPH : The subroutine to be passed to PSBLAS sparse library;
! uses information prepared by the previous two subroutines.
!
MODULE PARTGRAPH
public part_graph, build_grppart, distr_grppart,&
& getv_grppart, build_usrpart, free_part
private
integer, allocatable, save :: graph_vect(:)
CONTAINS
subroutine part_graph(global_indx,n,np,pv,nv)
integer, intent(in) :: global_indx, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
IF (.not.allocated(graph_vect)) then
write(0,*) 'Fatal error in PART_GRAPH: vector GRAPH_VECT ',&
& 'not initialized'
return
endif
if ((global_indx<1).or.(global_indx > size(graph_vect))) then
write(0,*) 'Fatal error in PART_GRAPH: index GLOBAL_INDX ',&
& 'outside GRAPH_VECT bounds',global_indx,size(graph_vect)
return
endif
nv = 1
pv(nv) = graph_vect(global_indx)
return
end subroutine part_graph
subroutine distr_grppart(root, ictxt)
use psb_sparse_mod
integer :: root, ictxt
integer :: n, me, np
call psb_info(ictxt,me,np)
if (.not.((root>=0).and.(root<np))) then
write(0,*) 'Fatal error in DISTR_GRPPART: invalid ROOT ',&
& 'coordinates '
call psb_abort(ictxt)
return
endif
if (me == root) then
if (.not.allocated(graph_vect)) then
write(0,*) 'Fatal error in DISTR_GRPPART: vector GRAPH_VECT ',&
& 'not initialized'
call psb_abort(ictxt)
return
endif
n = size(graph_vect)
call psb_bcast(ictxt,n,root=root)
else
call psb_bcast(ictxt,n,root=root)
allocate(graph_vect(n),stat=info)
if (info /= 0) then
write(0,*) 'Fatal error in DISTR_GRPPART: memory allocation ',&
& ' failure.'
return
endif
endif
call psb_bcast(ictxt,graph_vect(1:n),root=root)
return
end subroutine distr_grppart
subroutine getv_grppart(ivg)
integer, allocatable, intent(out) :: ivg(:)
if (allocated(graph_vect)) then
allocate(ivg(size(graph_vect)))
ivg(:) = graph_vect(:)
end if
end subroutine getv_grppart
subroutine build_grppart(n,fida,ia1,ia2,nparts)
use psb_sparse_mod
integer :: nparts
integer :: ia1(:), ia2(:)
integer :: n, i, ib, ii,numflag,nedc,wgflag
character(len=5) :: fida
integer, parameter :: nb=512
real(kind(1.d0)), parameter :: seed=12345.d0
real(kind(1.d0)) :: XV(NB)
integer :: iopt(10),idummy(2),jdummy(2)
interface
subroutine METIS_PartGraphRecursive(n,ixadj,iadj,ivwg,iajw,&
& wgflag,numflag,nparts,iopt,nedc,part)
integer :: n,wgflag,numflag,nparts,nedc
integer :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
end subroutine METIS_PartGraphRecursive
end interface
allocate(graph_vect(n),stat=info)
if (info /= 0) then
write(0,*) 'Fatal error in BUILD_GRPPART: memory allocation ',&
& ' failure.'
return
endif
if (nparts.gt.1) then
if (toupper(fida).eq.'CSR') then
iopt(1) = 0
numflag = 1
wgflag = 0
call METIS_PartGraphRecursive(n,ia2,ia1,idummy,jdummy,&
& wgflag,numflag,nparts,iopt,nedc,graph_vect)
do i=1, n
graph_vect(i) = graph_vect(i) - 1
enddo
else
write(0,*) 'Fatal error in BUILD_GRPPART: matrix format ',&
& ' failure. ', FIDA
return
endif
else
do i=1, n
graph_vect(i) = 0
enddo
endif
return
end subroutine build_grppart
subroutine build_usrpart(n,v,nparts)
integer :: nparts
integer :: v(:)
integer :: n, i, ib, ii,numflag,nedc,wgflag
if ((n<=0) .or. (nparts<1)) then
write(0,*) 'Invalid input to BUILD_USRPART ',n,nparts
return
endif
allocate(graph_vect(n),stat=info)
if (info /= 0) then
write(0,*) 'Fatal error in BUILD_USRPART: memory allocation ',&
& ' failure.'
return
endif
do i=1, n
if ((0<=v(i)).and.(v(i)<nparts)) then
graph_vect(i) = v(i)
else
write(0,*) 'Invalid V input to BUILD_USRPART',i,v(i),nparts
endif
end do
return
end subroutine build_usrpart
subroutine free_part(info)
integer :: info
deallocate(graph_vect,stat=info)
return
end subroutine free_part
END MODULE PARTGRAPH

253
test/Fileread/read_mat.f90
Unescape Escape View File

@ -1,253 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! READ_MAT subroutine reads a matrix and its right hand sides,
! all stored in Matrix Market format file. The B field is optional,.
!
! Character :: filename*20
! On Entry: name of file to be processed.
! On Exit : unchanged.
!
! Type(D_SPMAT) :: A
! On Entry: fresh variable.
! On Exit : will contain the global sparse matrix as follows:
! A%AS for coefficient values
! A%IA1 for column indices
! A%IA2 for row pointers
! A%M for number of global matrix rows
! A%K for number of global matrix columns
!
! Integer :: ICTXT
! On Entry: BLACS context.
! On Exit : unchanged.
!
! Real(Kind(1.D0)), Pointer, Optional :: B(:,:)
! On Entry: fresh variable.
! On Exit: will contain right hand side(s).
!
! Integer, Optional :: inroot
! On Entry: Index of root processor (default: 0)
! On Exit : unchanged.
!
module read_mat
interface readmat
module procedure dreadmat, zreadmat
end interface
interface read_rhs
module procedure dread_rhs, zread_rhs
end interface
contains
subroutine dreadmat (filename, a, ictxt, inroot)
use psb_sparse_mod
use mmio
implicit none
integer :: ictxt
type(psb_dspmat_type) :: a
character(len=*) :: filename
integer, optional :: inroot
integer, parameter :: infile = 2
integer :: info, root, nprow, npcol, myprow, mypcol
if (present(inroot)) then
root = inroot
else
root = 0
end if
call psb_info(ictxt, myprow, nprow)
if (myprow == root) then
write(*, '("Reading matrix...")') ! open input file
call mm_mat_read(a,info,infile,filename)
if (info /= 0) then
write(0,*) 'Error return from MM_MAT_READ ',info
call psb_abort(ictxt) ! Unexpected End of File
endif
end if
return
end subroutine dreadmat
subroutine dread_rhs (filename, b, ictxt, inroot)
use psb_sparse_mod
implicit none
integer :: ictxt
character :: filename*(*)
integer, optional :: inroot
integer, parameter :: infile = 2
integer :: nrow, ncol, i,root, nprow, npcol, myprow, mypcol, ircode, j
character :: mmheader*15, fmt*15, object*10, type*10, sym*15,&
& line*1024
real(kind(1.0d0)), allocatable :: b(:,:)
if (present(inroot)) then
root = inroot
else
root = 0
end if
call psb_info(ictxt, myprow, nprow)
if (myprow == root) then
write(*, '("Reading rhs...")') ! open input file
open(infile,file=filename, status='old', err=901, action="read")
read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym
write(0,*)'obj fmt',object, fmt
if ( (object .ne. 'matrix').or.(fmt.ne.'array')) then
write(0,*) 'read_rhs: input file type not yet supported'
call psb_abort(ictxt)
end if
do
read(infile,fmt='(a)') line
if (line(1:1) /= '%') exit
end do
read(line,fmt=*)nrow,ncol
if ((tolower(type) == 'real').and.(tolower(sym) == 'general')) then
allocate(b(nrow,ncol),stat = ircode)
if (ircode /= 0) goto 993
read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol)
else
write(0,*) 'read_rhs: rhs type not yet supported'
call psb_abort(ictxt)
end if ! read right hand sides
write(*,*) 'end read_rhs'
end if
return
! open failed
901 write(0,*) 'read_rhs: could not open file ',&
& infile,' for input'
call psb_abort(ictxt) ! unexpected end of file
902 write(0,*) 'read_rhs: unexpected end of file ',infile,&
& ' during input'
call psb_abort(ictxt) ! allocation failed
993 write(0,*) 'read_rhs: memory allocation failure'
call psb_abort(ictxt)
end subroutine dread_rhs
subroutine zreadmat (filename, a, ictxt, inroot)
use psb_sparse_mod
use mmio
implicit none
integer :: ictxt
type(psb_zspmat_type) :: a
character(len=*) :: filename
integer, optional :: inroot
integer, parameter :: infile = 2
integer :: info, root, nprow, npcol, myprow, mypcol
if (present(inroot)) then
root = inroot
else
root = 0
end if
call psb_info(ictxt, myprow, nprow)
if (myprow == root) then
write(*, '("Reading matrix...")') ! open input file
call mm_mat_read(a,info,infile,filename)
if (info /= 0) then
write(0,*) 'Error return from MM_MAT_READ ',info
call psb_abort(ictxt) ! Unexpected End of File
endif
end if
return
end subroutine zreadmat
subroutine zread_rhs (filename, b, ictxt, inroot)
use psb_sparse_mod
implicit none
integer :: ictxt
character :: filename*(*)
integer, optional :: inroot
integer, parameter :: infile = 2
integer :: nrow, ncol, i,root, nprow, npcol, myprow, mypcol, ircode, j
character :: mmheader*15, fmt*15, object*10, type*10, sym*15,&
& line*1024
real(kind(1.d0)) :: bre, bim
complex(kind(1.0d0)), allocatable :: b(:,:)
if (present(inroot)) then
root = inroot
else
root = 0
end if
call psb_info(ictxt, myprow, nprow)
if (myprow == root) then
write(*, '("Reading rhs...")') ! open input file
open(infile,file=filename, status='old', err=901, action="read")
read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym
!!$ write(0,*)'obj fmt',object, fmt
if ( (object .ne. 'matrix').or.(fmt.ne.'array')) then
write(0,*) 'read_rhs: input file type not yet supported'
call psb_abort(ictxt)
end if
do
read(infile,fmt='(a)') line
if (line(1:1) /= '%') exit
end do
read(line,fmt=*)nrow,ncol
if ((tolower(type) == 'complex').and.(tolower(sym) == 'general')) then
allocate(b(nrow,ncol),stat = ircode)
if (ircode /= 0) goto 993
do j=1, ncol
do i=1, nrow
read(infile,fmt=*,end=902) bre,bim
b(i,j) = cmplx(bre,bim)
end do
end do
else
write(0,*) 'read_rhs: rhs type not yet supported'
call psb_abort(ictxt)
end if ! read right hand sides
write(*,*) 'end read_rhs'
end if
return
! open failed
901 write(0,*) 'read_rhs: could not open file ',&
& infile,' for input'
call psb_abort(ictxt) ! unexpected end of file
902 write(0,*) 'read_rhs: unexpected end of file ',infile,&
& ' during input'
call psb_abort(ictxt) ! allocation failed
993 write(0,*) 'read_rhs: memory allocation failure'
call psb_abort(ictxt)
end subroutine zread_rhs
end module read_mat

36
test/fileread/Makefile
Unescape Escape View File

@ -0,0 +1,36 @@
include ../../Make.inc
#
# Libraries used
#
LIBDIR=../../lib/
PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base
INCDIRS=-I$(LIBDIR)
DFOBJS=getp.o df_sample.o
ZFOBJS=getp.o zf_sample.o
EXEDIR=./runs
all: df_sample zf_sample
df_sample: $(DFOBJS)
$(F90LINK) $(DFOBJS) -o df_sample $(PSBLAS_LIB) $(LDLIBS)
/bin/mv df_sample $(EXEDIR)
zf_sample: $(ZFOBJS)
$(F90LINK) $(ZFOBJS) -o zf_sample $(PSBLAS_LIB) $(LDLIBS)
/bin/mv zf_sample $(EXEDIR)
.f90.o:
$(MPF90) $(F90COPT) $(INCDIRS) -c $<
clean:
/bin/rm -f $(DFOBJS) $(ZFOBJS) \
*$(.mod) $(EXEDIR)/df_sample $(EXEDIR)/zf_sample
lib:
(cd ../../; make library)
verycleanlib:
(cd ../../; make veryclean)

53
test/Fileread/df_sample.f90 → test/fileread/df_sample.f90
Unescape Escape View File

@ -29,10 +29,10 @@
!!$ !!$
!!$ !!$
program df_sample program df_sample
use psb_sparse_mod use psb_base_mod
use mat_dist use psb_prec_mod
use read_mat use psb_krylov_mod
use partgraph use psb_util_mod
use getp use getp
implicit none implicit none
@ -40,25 +40,6 @@ program df_sample
character*40 :: cmethd, mtrx_file, rhs_file character*40 :: cmethd, mtrx_file, rhs_file
character*80 :: charbuf character*80 :: charbuf
interface
! .....user passed subroutine.....
subroutine part_block(global_indx,n,np,pv,nv)
implicit none
integer, intent(in) :: global_indx, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
end subroutine part_block
end interface ! local variables
interface
! .....user passed subroutine.....
subroutine part_blk2(global_indx,n,np,pv,nv)
implicit none
integer, intent(in) :: global_indx, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
end subroutine part_blk2
end interface ! local variables
! sparse matrices ! sparse matrices
type(psb_dspmat_type) :: a, aux_a type(psb_dspmat_type) :: a, aux_a
@ -126,7 +107,7 @@ program df_sample
nrhs = 1 nrhs = 1
if (amroot) then if (amroot) then
call readmat(mtrx_file, aux_a, ictxt) call read_mat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m m_problem = aux_a%m
call psb_bcast(ictxt,m_problem) call psb_bcast(ictxt,m_problem)
@ -175,17 +156,7 @@ program df_sample
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
call matdist(aux_a, a, ivg, ictxt, & call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
else if (ipart.eq.1) then
call psb_barrier(ictxt)
if (amroot) write(*,'("Partition type: blk2")')
allocate(ivg(m_problem),ipv(np))
do i=1,m_problem
call part_blk2(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
else if (ipart.eq.2) then else if (ipart.eq.2) then
if (amroot) then if (amroot) then
@ -197,11 +168,11 @@ program df_sample
call psb_barrier(ictxt) call psb_barrier(ictxt)
call distr_grppart(root,ictxt) call distr_grppart(root,ictxt)
call getv_grppart(ivg) call getv_grppart(ivg)
call matdist(aux_a, a, ivg, ictxt, & call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
else else
if (amroot) write(*,'("Partition type: block")') if (amroot) write(*,'("Partition type: block")')
call matdist(aux_a, a, part_block, ictxt, & call psb_matdist(aux_a, a, part_block, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
end if end if
@ -237,14 +208,6 @@ program df_sample
call psb_precset(pre,'diagsc',info) call psb_precset(pre,'diagsc',info)
case(bja_) case(bja_)
call psb_precset(pre,'ilu',info) call psb_precset(pre,'ilu',info)
case(asm_)
call psb_precset(pre,'asm',info,iv=(/novr,halo_,sum_/))
case(ash_)
call psb_precset(pre,'asm',info,iv=(/novr,nohalo_,sum_/))
case(ras_)
call psb_precset(pre,'asm',info,iv=(/novr,halo_,none_/))
case(rash_)
call psb_precset(pre,'asm',info,iv=(/novr,nohalo_,none_/))
case default case default
call psb_precset(pre,'ilu',info) call psb_precset(pre,'ilu',info)
end select end select

2
test/Fileread/getp.f90 → test/fileread/getp.f90
Unescape Escape View File

@ -29,7 +29,7 @@
!!$ !!$
!!$ !!$
Module getp Module getp
use psb_sparse_mod use psb_base_mod
public get_parms public get_parms
public pr_usage public pr_usage

0
test/Fileread/RUNS/Makefile → test/fileread/runs/Makefile
Unescape Escape View File

0
test/Fileread/RUNS/dfs.inp → test/fileread/runs/dfs.inp
Unescape Escape View File

0
test/Fileread/RUNS/zfs.inp → test/fileread/runs/zfs.inp
Unescape Escape View File

54
test/Fileread/zf_sample.f90 → test/fileread/zf_sample.f90
Unescape Escape View File

@ -29,10 +29,10 @@
!!$ !!$
!!$ !!$
program zf_sample program zf_sample
use psb_sparse_mod use psb_base_mod
use mat_dist use psb_prec_mod
use read_mat use psb_krylov_mod
use partgraph use psb_util_mod
use getp use getp
implicit none implicit none
@ -40,26 +40,6 @@ program zf_sample
character*40 :: cmethd, mtrx_file, rhs_file character*40 :: cmethd, mtrx_file, rhs_file
character*80 :: charbuf character*80 :: charbuf
interface
! .....user passed subroutine.....
subroutine part_block(global_indx,n,np,pv,nv)
implicit none
integer, intent(in) :: global_indx, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
end subroutine part_block
end interface ! local variables
interface
! .....user passed subroutine.....
subroutine part_blk2(global_indx,n,np,pv,nv)
implicit none
integer, intent(in) :: global_indx, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
end subroutine part_blk2
end interface ! local variables
! sparse matrices ! sparse matrices
type(psb_zspmat_type) :: a, aux_a type(psb_zspmat_type) :: a, aux_a
@ -127,7 +107,7 @@ program zf_sample
nrhs = 1 nrhs = 1
if (amroot) then if (amroot) then
call readmat(mtrx_file, aux_a, ictxt) call read_mat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m m_problem = aux_a%m
call psb_bcast(ictxt,m_problem) call psb_bcast(ictxt,m_problem)
@ -176,17 +156,7 @@ program zf_sample
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
call matdist(aux_a, a, ivg, ictxt, & call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
else if (ipart.eq.1) then
call psb_barrier(ictxt)
if (amroot) write(*,'("Partition type: blk2")')
allocate(ivg(m_problem),ipv(np))
do i=1,m_problem
call part_blk2(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
else if (ipart.eq.2) then else if (ipart.eq.2) then
if (amroot) then if (amroot) then
@ -198,11 +168,11 @@ program zf_sample
call psb_barrier(ictxt) call psb_barrier(ictxt)
call distr_grppart(root,ictxt) call distr_grppart(root,ictxt)
call getv_grppart(ivg) call getv_grppart(ivg)
call matdist(aux_a, a, ivg, ictxt, & call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
else else
if (amroot) write(*,'("Partition type: block")') if (amroot) write(*,'("Partition type: block")')
call matdist(aux_a, a, part_block, ictxt, & call psb_matdist(aux_a, a, part_block, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
end if end if
@ -238,14 +208,6 @@ program zf_sample
call psb_precset(pre,'diagsc',info) call psb_precset(pre,'diagsc',info)
case(bja_) case(bja_)
call psb_precset(pre,'ilu',info) call psb_precset(pre,'ilu',info)
case(asm_)
call psb_precset(pre,'asm',info,iv=(/novr,halo_,sum_/))
case(ash_)
call psb_precset(pre,'asm',info,iv=(/novr,nohalo_,sum_/))
case(ras_)
call psb_precset(pre,'asm',info,iv=(/novr,halo_,none_/))
case(rash_)
call psb_precset(pre,'asm',info,iv=(/novr,nohalo_,none_/))
case default case default
call psb_precset(pre,'ilu',info) call psb_precset(pre,'ilu',info)
end select end select

14
test/pargen/Makefile
Unescape Escape View File

@ -3,7 +3,7 @@ include ../../Make.inc
# Libraries used # Libraries used
# #
LIBDIR=../../lib/ LIBDIR=../../lib/
PSBLAS_LIB= -L$(LIBDIR) -lpsblas PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base
# #
# Compilers and such # Compilers and such
@ -12,24 +12,20 @@ CCOPT= -g
INCDIRS=-I$(LIBDIR) INCDIRS=-I$(LIBDIR)
EXEDIR=./RUNS EXEDIR=./runs
LINKOPT=$(F90COPT) ppde90: ppde90.o
$(F90LINK) ppde90.o -o ppde90 $(PSBLAS_LIB) $(LDLIBS)
ppde90: ppde90.o part_block.o
$(F90LINK) $(LINKOPT) ppde90.o part_block.o -o ppde90\
$(PSBLAS_LIB) $(BLACS) $(SLU) $(UMF) $(BLAS)
/bin/mv ppde90 $(EXEDIR) /bin/mv ppde90 $(EXEDIR)
ppde90.o: $(MODS)
.f90.o: .f90.o:
$(MPF90) $(F90COPT) $(INCDIRS) -c $< $(MPF90) $(F90COPT) $(INCDIRS) -c $<
clean: clean:
/bin/rm -f ppde90.o pp2d.o part_block.o $(EXEDIR)/ppde90 $(EXEDIR)/pp2d /bin/rm -f ppde90.o $(EXEDIR)/ppde90
verycleanlib: verycleanlib:
(cd ../..; make veryclean) (cd ../..; make veryclean)
lib: lib:

80
test/pargen/part_block.f
Unescape Escape View File

@ -1,80 +0,0 @@
C
C Parallel Sparse BLAS v2.0
C (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
C
C User defined function corresponding to an HPF BLOCK partition
C
SUBROUTINE PART_BLOCK(GLOBAL_INDX,N,NP,PV,NV)
IMPLICIT NONE
INTEGER GLOBAL_INDX, N, NP
INTEGER NV
INTEGER PV(*)
INTEGER DIM_BLOCK
DOUBLE PRECISION DDIFF
INTEGER IB1, IB2, IPV
double precision PC
PARAMETER (PC=0.0D0)
DIM_BLOCK = (N + NP - 1)/NP
NV = 1
PV(NV) = (GLOBAL_INDX - 1) / DIM_BLOCK
IPV = PV(1)
IB1 = IPV * DIM_BLOCK + 1
IB2 = (IPV+1) * DIM_BLOCK
DDIFF = DBLE(ABS(GLOBAL_INDX-IB1))/DBLE(DIM_BLOCK)
IF (DDIFF .LT. PC/2) THEN
C
C Overlap at the beginning of a block, with the previous proc
C
IF (IPV.GT.0) THEN
NV = NV + 1
PV(NV) = IPV - 1
ENDIF
ENDIF
DDIFF = DBLE(ABS(GLOBAL_INDX-IB2))/DBLE(DIM_BLOCK)
IF (DDIFF .LT. PC/2) THEN
C
C Overlap at the end of a block, with the next proc
C
IF (IPV.LT.(NP-1)) THEN
NV = NV + 1
PV(NV) = IPV + 1
ENDIF
ENDIF
RETURN
END

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

@ -71,17 +71,12 @@
! u(x,y) = rhs(x,y) ! u(x,y) = rhs(x,y)
! !
program pde90 program pde90
use psb_sparse_mod use psb_base_mod
use psb_prec_mod
use psb_krylov_mod
use psb_util_mod
implicit none implicit none
interface
!.....user passed subroutine.....
subroutine part_block(glob_index,n,np,pv,nv)
integer, intent(in) :: glob_index, n, np
integer, intent(out) :: nv
integer, intent(out) :: pv(*)
end subroutine part_block
end interface
! input parameters ! input parameters
character :: cmethd*10, prec*10, afmt*5 character :: cmethd*10, prec*10, afmt*5
integer :: idim, iret integer :: idim, iret
@ -164,14 +159,6 @@ program pde90
call psb_precset(pre,'diagsc',info) call psb_precset(pre,'diagsc',info)
case(bja_) case(bja_)
call psb_precset(pre,'ilu',info) call psb_precset(pre,'ilu',info)
case(asm_)
call psb_precset(pre,'asm',info,iv=(/novr,halo_,sum_/))
case(ash_)
call psb_precset(pre,'asm',info,iv=(/novr,nohalo_,sum_/))
case(ras_)
call psb_precset(pre,'asm',info,iv=(/novr,halo_,none_/))
case(rash_)
call psb_precset(pre,'asm',info,iv=(/novr,nohalo_,none_/))
case default case default
call psb_precset(pre,'ilu',info) call psb_precset(pre,'ilu',info)
end select end select
@ -392,7 +379,7 @@ contains
! u(x,y,z)(2b1+2b2+2b3+a1+a2+a3)+u(x-1,y,z)(-b1-a1)+u(x,y-1,z)(-b2-a2)+ ! u(x,y,z)(2b1+2b2+2b3+a1+a2+a3)+u(x-1,y,z)(-b1-a1)+u(x,y-1,z)(-b2-a2)+
! + u(x,y,z-1)(-b3-a3)-u(x+1,y,z)b1-u(x,y+1,z)b2-u(x,y,z+1)b3 ! + u(x,y,z-1)(-b3-a3)-u(x+1,y,z)b1-u(x,y+1,z)b2-u(x,y,z+1)b3
use psb_sparse_mod use psb_base_mod
implicit none implicit none
integer :: idim integer :: idim
integer, parameter :: nbmax=10 integer, parameter :: nbmax=10

0
test/pargen/RUNS/Makefile → test/pargen/runs/Makefile
Unescape Escape View File

0
test/pargen/RUNS/mach → test/pargen/runs/mach
Unescape Escape View File

2
test/pargen/RUNS/ppde.inp → test/pargen/runs/ppde.inp
Unescape Escape View File

@ -1,6 +1,6 @@
7 Number of entries below this 7 Number of entries below this
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL
2 Preconditioner ILU DIAGSC NONE 2 Preconditioner 2=ILU 1=DIAGSC 0=NONE
2 Number ov overlapping levels 2 Number ov overlapping levels
COO A Storage format CSR COO JAD COO A Storage format CSR COO JAD
20 Domain size (acutal sistem is this**3) 20 Domain size (acutal sistem is this**3)

42
test/util/Makefile
Unescape Escape View File

@ -0,0 +1,42 @@
include ../../Make.inc
#
# Libraries used
#
LIBDIR=../../lib/
PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_base
#
# We are using the public domain tool METIS from U. Minnesota. To get it
# check URL http://www.cs.umn.edu:~karypis
#
INCDIRS=-I$(LIBDIR)
ZH2MOBJS=zhb2mm.o
DH2MOBJS=dhb2mm.o
DM2HOBJS=dmm2hb.o
ZM2HOBJS=zmm2hb.o
MMHBOBJS=$(ZH2MOBJS) $(DH2MOBJS) $(DM2HOBJS) $(ZM2HOBJS)
all: dhb2mm zhb2mm dmm2hb zmm2hb
dhb2mm: $(DH2MOBJS)
$(MPF90) -o dhb2mm $(DH2MOBJS) $(PSBLAS_LIB) $(LDLIBS)
dmm2hb: $(DM2HOBJS)
$(MPF90) -o dmm2hb $(DM2HOBJS) $(PSBLAS_LIB) $(LDLIBS)
zhb2mm: $(ZH2MOBJS)
$(MPF90) -o zhb2mm $(ZH2MOBJS) $(PSBLAS_LIB) $(LDLIBS)
zmm2hb: $(ZM2HOBJS)
$(MPF90) -o zmm2hb $(ZM2HOBJS) $(PSBLAS_LIB) $(LDLIBS)
.f90.o:
$(MPF90) $(F90COPT) $(INCDIRS) -c $<
clean:
/bin/rm -f $(MMHBOBJS) dhb2mm zhb2mm dmm2hb zmm2hb
lib:
(cd ../../; make library)
verycleanlib:
(cd ../../; make veryclean)

5
test/Fileread/dhb2mm.f90 → test/util/dhb2mm.f90
Unescape Escape View File

@ -34,9 +34,8 @@
! format ! format
! !
program dhb2mm program dhb2mm
use psb_sparse_mod use psb_base_mod
use mmio use psb_util_mod
use hbio
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
integer :: info integer :: info

5
test/Fileread/dmm2hb.f90 → test/util/dmm2hb.f90
Unescape Escape View File

@ -34,9 +34,8 @@
! format ! format
! !
program dmm2hb program dmm2hb
use psb_sparse_mod use psb_base_mod
use mmio use psb_util_mod
use hbio
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
integer info integer info

5
test/Fileread/zhb2mm.f90 → test/util/zhb2mm.f90
Unescape Escape View File

@ -34,9 +34,8 @@
! format ! format
! !
program zhb2mm program zhb2mm
use psb_sparse_mod use psb_base_mod
use mmio use psb_util_mod
use hbio
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
integer :: info integer :: info

5
test/Fileread/zmm2hb.f90 → test/util/zmm2hb.f90
Unescape Escape View File

@ -34,9 +34,8 @@
! format ! format
! !
program zmm2hb program zmm2hb
use psb_sparse_mod use psb_base_mod
use mmio use psb_util_mod
use hbio
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
integer info integer info
Write Preview
Loading…
Cancel
Save