fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 19:32:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas2:

Browse Source 
config/pac.m4
 configure
 docs/pdf/util.tex
 docs/userguide.pdf
 test/fileread/cf_sample.f90
 test/fileread/df_sample.f90
 test/fileread/getp.f90
 test/fileread/runs/cfs.inp
 test/fileread/runs/dfs.inp
 test/fileread/runs/sfs.inp
 test/fileread/runs/zfs.inp
 test/fileread/sf_sample.f90
 test/fileread/zf_sample.f90
 util/Makefile
 util/psb_hbio_mod.f90
 util/psb_mmio_mod.f90
 util/psb_read_mat_mod.f90
 util/psb_util_mod.f90

Fixed I/O for fileread samples.
This commit is contained in:
Salvatore Filippone
2008-07-22 16:51:33 +00:00
parent e8f6804783
commit a25813858e
18 changed files with 17821 additions and 33097 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/fileread/cf_sample.f90
+30 -9
View File
@@ -64,6 +64,8 @@ program cf_sample
character(len=5) :: afmt
character(len=20) :: name
character(len=2) :: filefmt
integer, parameter :: iunit=12
integer :: iparm(20)
! other variables
@@ -92,7 +94,7 @@ program cf_sample
!
! get parameters
!
call get_parms(ictxt,mtrx_file,rhs_file,kmethd,ptype,&
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
& ipart,afmt,istopc,itmax,itrace,irst,eps)
call psb_barrier(ictxt)
@@ -101,16 +103,35 @@ program cf_sample
nrhs = 1
if (iam==psb_root_) then
call read_mat(mtrx_file, aux_a, ictxt)
select case(psb_toupper(filefmt))
case('MM')
! For Matrix Market we have an input file for the matrix
! and an (optional) second file for the RHS.
call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
if (info == 0) then
if (rhs_file /= 'NONE') then
call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file)
end if
end if
case ('HB')
! For Harwell-Boeing we have a single file which may or may not
! contain an RHS.
call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
case default
info = -1
write(0,*) 'Wrong choice for fileformat ', filefmt
end select
if (info /= 0) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
end if
m_problem = aux_a%m
call psb_bcast(ictxt,m_problem)
if(rhs_file /= 'NONE') then
! reading an rhs
call read_rhs(rhs_file,aux_b,info,ictxt)
end if
! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=1)==m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
test/fileread/df_sample.f90
+34 -10
View File
@@ -64,6 +64,8 @@ program df_sample
character(len=5) :: afmt
character(len=20) :: name
character(len=2) :: filefmt
integer, parameter :: iunit=12
integer :: iparm(20)
! other variables
@@ -92,7 +94,7 @@ program df_sample
!
! get parameters
!
call get_parms(ictxt,mtrx_file,rhs_file,kmethd,ptype,&
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
& ipart,afmt,istopc,itmax,itrace,irst,eps)
call psb_barrier(ictxt)
@@ -101,16 +103,35 @@ program df_sample
nrhs = 1
if (iam==psb_root_) then
call read_mat(mtrx_file, aux_a, ictxt)
select case(psb_toupper(filefmt))
case('MM')
! For Matrix Market we have an input file for the matrix
! and an (optional) second file for the RHS.
call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
if (info == 0) then
if (rhs_file /= 'NONE') then
call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file)
end if
end if
case ('HB')
! For Harwell-Boeing we have a single file which may or may not
! contain an RHS.
call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
case default
info = -1
write(0,*) 'Wrong choice for fileformat ', filefmt
end select
if (info /= 0) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
end if
m_problem = aux_a%m
call psb_bcast(ictxt,m_problem)
if(rhs_file /= 'NONE') then
! reading an rhs
call read_rhs(rhs_file,aux_b,info,ictxt)
end if
! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=1)==m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
@@ -123,14 +144,16 @@ program df_sample
call psb_errpush(4000,name)
goto 9999
endif
b_col_glob => aux_b(:,1)
do i=1, m_problem
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
@@ -139,6 +162,7 @@ program df_sample
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
! switch over different partition types
test/fileread/getp.f90
+10 -2
View File
@@ -38,10 +38,11 @@ contains
!
! Get iteration parameters from the command line
!
subroutine get_dparms(ictxt,mtrx_file,rhs_file,kmethd,ptype,ipart,&
subroutine get_dparms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,ipart,&
& afmt,istopc,itmax,itrace,irst,eps)
use psb_base_mod
integer :: ictxt
character(len=2) :: filefmt
character(len=40) :: kmethd, mtrx_file, rhs_file, ptype
integer :: iret, istopc,itmax,itrace,ipart,irst
character(len=40) :: charbuf
@@ -57,6 +58,7 @@ contains
if (ip >= 5) then
read(*,*) mtrx_file
read(*,*) rhs_file
read(*,*) filefmt
read(*,*) kmethd
read(*,*) ptype
read(*,*) afmt
@@ -64,6 +66,7 @@ contains
call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,kmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt)
@@ -119,6 +122,7 @@ contains
! Receive Parameters
call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,kmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt)
@@ -135,10 +139,11 @@ contains
end subroutine get_dparms
subroutine get_sparms(ictxt,mtrx_file,rhs_file,kmethd,ptype,ipart,&
subroutine get_sparms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,ipart,&
& afmt,istopc,itmax,itrace,irst,eps)
use psb_base_mod
integer :: ictxt
character(len=2) :: filefmt
character(len=40) :: kmethd, mtrx_file, rhs_file, ptype
integer :: iret, istopc,itmax,itrace,ipart,irst
character(len=40) :: charbuf
@@ -154,6 +159,7 @@ contains
if (ip >= 5) then
read(*,*) mtrx_file
read(*,*) rhs_file
read(*,*) filefmt
read(*,*) kmethd
read(*,*) ptype
read(*,*) afmt
@@ -161,6 +167,7 @@ contains
call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,kmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt)
@@ -216,6 +223,7 @@ contains
! Receive Parameters
call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,filefmt)
call psb_bcast(ictxt,kmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt)
test/fileread/runs/cfs.inp
+3 -2
View File
@@ -1,7 +1,8 @@
11 Number of inputs
young1c.mtx waveguide3D.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
young1c.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
MM File format: MM: Matrix Market HB: Harwell-Boeing.
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
test/fileread/runs/dfs.inp
+7 -6
View File
@@ -1,12 +1,13 @@
11 Number of inputs
thm1000x600.mtx young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE rhs.mtx NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
BJAC Preconditioner NONE DIAG BJAC
sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
sherman3_rhs1.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
MM File format: MM: Matrix Market HB: Harwell-Boeing.
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
2 IPART: Partition method 0: BLK 2: graph (with Metis)
0 IPART: Partition method 0: BLK 2: graph (with Metis)
2 ISTOPC
01000 ITMAX
-1 ITRACE
01 ITRACE
30 IRST (restart for RGMRES and BiCGSTABL)
1.d-6 EPS
test/fileread/runs/sfs.inp
+3 -2
View File
@@ -1,7 +1,8 @@
11 Number of inputs
thm1000x600.mtx young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTABL Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
MM File format: MM: Matrix Market HB: Harwell-Boeing.
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
test/fileread/runs/zfs.inp
+4 -3
View File
@@ -1,7 +1,8 @@
11 Number of inputs
kim1.mtx aft02.mtx qc2534.mtx young1c.mtx waveguide3D.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
CGS Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
young1c.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
MM File format: MM: Matrix Market HB: Harwell-Boeing.
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
test/fileread/sf_sample.f90
+30 -9
View File
@@ -64,6 +64,8 @@ program sf_sample
character(len=5) :: afmt
character(len=20) :: name
character(len=2) :: filefmt
integer, parameter :: iunit=12
integer :: iparm(20)
! other variables
@@ -92,7 +94,7 @@ program sf_sample
!
! get parameters
!
call get_parms(ictxt,mtrx_file,rhs_file,kmethd,ptype,&
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
& ipart,afmt,istopc,itmax,itrace,irst,eps)
call psb_barrier(ictxt)
@@ -101,16 +103,35 @@ program sf_sample
nrhs = 1
if (iam==psb_root_) then
call read_mat(mtrx_file, aux_a, ictxt)
select case(psb_toupper(filefmt))
case('MM')
! For Matrix Market we have an input file for the matrix
! and an (optional) second file for the RHS.
call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
if (info == 0) then
if (rhs_file /= 'NONE') then
call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file)
end if
end if
case ('HB')
! For Harwell-Boeing we have a single file which may or may not
! contain an RHS.
call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
case default
info = -1
write(0,*) 'Wrong choice for fileformat ', filefmt
end select
if (info /= 0) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
end if
m_problem = aux_a%m
call psb_bcast(ictxt,m_problem)
if(rhs_file /= 'NONE') then
! reading an rhs
call read_rhs(rhs_file,aux_b,info,ictxt)
end if
! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=1)==m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
test/fileread/zf_sample.f90
+30 -9
View File
@@ -64,6 +64,8 @@ program zf_sample
character(len=5) :: afmt
character(len=20) :: name
character(len=2) :: filefmt
integer, parameter :: iunit=12
integer :: iparm(20)
! other variables
@@ -92,7 +94,7 @@ program zf_sample
!
! get parameters
!
call get_parms(ictxt,mtrx_file,rhs_file,kmethd,ptype,&
call get_parms(ictxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
& ipart,afmt,istopc,itmax,itrace,irst,eps)
call psb_barrier(ictxt)
@@ -101,16 +103,35 @@ program zf_sample
nrhs = 1
if (iam==psb_root_) then
call read_mat(mtrx_file, aux_a, ictxt)
select case(psb_toupper(filefmt))
case('MM')
! For Matrix Market we have an input file for the matrix
! and an (optional) second file for the RHS.
call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
if (info == 0) then
if (rhs_file /= 'NONE') then
call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file)
end if
end if
case ('HB')
! For Harwell-Boeing we have a single file which may or may not
! contain an RHS.
call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
case default
info = -1
write(0,*) 'Wrong choice for fileformat ', filefmt
end select
if (info /= 0) then
write(0,*) 'Error while reading input matrix '
call psb_abort(ictxt)
end if
m_problem = aux_a%m
call psb_bcast(ictxt,m_problem)
if(rhs_file /= 'NONE') then
! reading an rhs
call read_rhs(rhs_file,aux_b,info,ictxt)
end if
! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=1)==m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')