Reorganization of test dir.
Salvatore Filippone
18 years ago
parent
7a3e36db56
commit
0383e80618
@ -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)
|
||||
|
||||
@ -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
|
||||
File diff suppressed because it is too large
Load Diff
@ -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
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
7 Number of entries below this
|
||||
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
|
||||
COO A Storage format CSR COO JAD
|
||||
20 Domain size (acutal sistem is this**3)
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue