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

Adjusted test programs to ALLOCATABLEs.

Browse Source
This commit is contained in:
Salvatore Filippone
2006-11-10 09:56:51 +00:00
parent 656eba0524
commit f6655e698d
6 changed files with 62 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/Fileread/df_sample.f90
+9 -9
View File
@@ -68,9 +68,10 @@ program df_sample
integer :: igsmth, matop, novr
! dense matrices
real(kind(1.d0)), pointer :: aux_b(:,:), d(:)
real(kind(1.d0)), pointer, save :: b_col(:), x_col(:), r_col(:), &
& b_col_glob(:), x_col_glob(:), r_col_glob(:)
real(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
real(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& x_col_glob(:), r_col_glob(:)
real(kind(1.d0)), pointer :: b_col_glob(:)
! communications data structure
type(psb_desc_type):: desc_a
@@ -125,7 +126,6 @@ program df_sample
nrhs = 1
if (amroot) then
nullify(aux_b)
call readmat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m
@@ -136,14 +136,14 @@ program df_sample
call read_rhs(rhs_file,aux_b,ictxt)
end if
if (associated(aux_b).and.size(aux_b,1)==m_problem) then
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 ")')
b_col_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
allocate(aux_b(m_problem,1), stat=ircode)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(4000,name)
goto 9999
@@ -157,7 +157,7 @@ program df_sample
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
allocate(aux_b(m_problem,1), stat=ircode)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(4000,name)
goto 9999
@@ -274,8 +274,8 @@ program df_sample
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_geaxpby(1.d0,b_col,0.d0,r_col,desc_a,info)
call psb_spmm(-1.d0,a,x_col,1.d0,r_col,desc_a,info)
call psb_geaxpby(done,b_col,dzero,r_col,desc_a,info)
call psb_spmm(-done,a,x_col,done,r_col,desc_a,info)
call psb_genrm2s(resmx,r_col,desc_a,info)
call psb_geamaxs(resmxp,r_col,desc_a,info)
test/Fileread/mat_dist.f90
+20 -20
View File
@@ -82,11 +82,11 @@ contains
! on entry: fresh variable.
! on exit : the updated array descriptor
!
! real(kind(1.d0)), pointer, optional :: b_glob(:)
! real(kind(1.d0)), optional :: b_glob(:)
! on entry: this contains right hand side.
! on exit :
!
! real(kind(1.d0)), pointer, optional :: b(:)
! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable.
! on exit : this will contain the local right hand side.
!
@@ -99,10 +99,10 @@ contains
! parameters
type(psb_dspmat_type) :: a_glob
real(kind(1.d0)), pointer :: b_glob(:)
real(kind(1.d0)) :: b_glob(:)
integer :: ictxt
type(psb_dspmat_type) :: a
real(kind(1.d0)), pointer :: b(:)
real(kind(1.d0)), allocatable :: b(:)
type (psb_desc_type) :: desc_a
integer, intent(out) :: info
integer, optional :: inroot
@@ -123,7 +123,7 @@ contains
integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer, pointer :: iwork(:)
integer, allocatable :: iwork(:)
character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:)
real(kind(1.d0)), allocatable :: val(:)
@@ -530,11 +530,11 @@ contains
! on entry: fresh variable.
! on exit : the updated array descriptor
!
! real(kind(1.d0)), pointer, optional :: b_glob(:)
! real(kind(1.d0)), optional :: b_glob(:)
! on entry: this contains right hand side.
! on exit :
!
! real(kind(1.d0)), pointer, optional :: b(:)
! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable.
! on exit : this will contain the local right hand side.
!
@@ -545,10 +545,10 @@ contains
use psb_sparse_mod
implicit none ! parameters
type(psb_dspmat_type) :: a_glob
real(kind(1.d0)), pointer :: b_glob(:)
real(kind(1.d0)) :: b_glob(:)
integer :: ictxt, v(:)
type(psb_dspmat_type) :: a
real(kind(1.d0)), pointer :: b(:)
real(kind(1.d0)), allocatable :: b(:)
type (psb_desc_type) :: desc_a
integer, intent(out) :: info
integer, optional :: inroot
@@ -558,7 +558,7 @@ contains
integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer, pointer :: iwork(:)
integer, allocatable :: iwork(:)
character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:)
real(kind(1.d0)), allocatable :: val(:)
@@ -857,11 +857,11 @@ contains
! on entry: fresh variable.
! on exit : the updated array descriptor
!
! real(kind(1.d0)), pointer, optional :: b_glob(:)
! real(kind(1.d0)), optional :: b_glob(:)
! on entry: this contains right hand side.
! on exit :
!
! real(kind(1.d0)), pointer, optional :: b(:)
! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable.
! on exit : this will contain the local right hand side.
!
@@ -874,10 +874,10 @@ contains
! parameters
type(psb_zspmat_type) :: a_glob
complex(kind(1.d0)), pointer :: b_glob(:)
complex(kind(1.d0)) :: b_glob(:)
integer :: ictxt
type(psb_zspmat_type) :: a
complex(kind(1.d0)), pointer :: b(:)
complex(kind(1.d0)), allocatable :: b(:)
type (psb_desc_type) :: desc_a
integer, intent(out) :: info
integer, optional :: inroot
@@ -898,7 +898,7 @@ contains
integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer, pointer :: iwork(:)
integer, allocatable :: iwork(:)
character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:)
complex(kind(1.d0)), allocatable :: val(:)
@@ -1302,11 +1302,11 @@ contains
! on entry: fresh variable.
! on exit : the updated array descriptor
!
! real(kind(1.d0)), pointer, optional :: b_glob(:)
! real(kind(1.d0)), optional :: b_glob(:)
! on entry: this contains right hand side.
! on exit :
!
! real(kind(1.d0)), pointer, optional :: b(:)
! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable.
! on exit : this will contain the local right hand side.
!
@@ -1317,10 +1317,10 @@ contains
use psb_sparse_mod
implicit none ! parameters
type(psb_zspmat_type) :: a_glob
complex(kind(1.d0)), pointer :: b_glob(:)
complex(kind(1.d0)) :: b_glob(:)
integer :: ictxt, v(:)
type(psb_zspmat_type) :: a
complex(kind(1.d0)), pointer :: b(:)
complex(kind(1.d0)), allocatable :: b(:)
type(psb_desc_type) :: desc_a
integer, intent(out) :: info
integer, optional :: inroot
@@ -1330,7 +1330,7 @@ contains
integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5)
integer, pointer :: iwork(:)
integer, allocatable :: iwork(:)
character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:)
complex(kind(1.d0)), allocatable :: val(:)
test/Fileread/read_mat.f90
+4 -16
View File
@@ -57,12 +57,6 @@
! On Entry: Index of root processor (default: 0)
! On Exit : unchanged.
!
! Real(Kind(1.D0)), Pointer, Optional :: indwork(:)
! On Entry/Exit: Double Precision Work Area.
!
! Integer, Pointer, Optional :: iniwork()
! On Entry/Exit: Integer Work Area.
!
module read_mat
interface readmat
module procedure dreadmat, zreadmat
@@ -104,20 +98,17 @@ contains
end subroutine dreadmat
subroutine dread_rhs (filename, b, ictxt, inroot,&
& indwork, iniwork)
subroutine dread_rhs (filename, b, ictxt, inroot)
use psb_sparse_mod
implicit none
integer :: ictxt
character :: filename*(*)
integer, optional :: inroot
real(kind(1.0d0)), pointer, optional :: indwork(:)
integer, pointer, optional :: iniwork(:) ! local variables
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)), pointer :: b(:,:)
real(kind(1.0d0)), allocatable :: b(:,:)
if (present(inroot)) then
root = inroot
else
@@ -195,20 +186,17 @@ contains
end subroutine zreadmat
subroutine zread_rhs (filename, b, ictxt, inroot,&
& indwork, iniwork)
subroutine zread_rhs (filename, b, ictxt, inroot)
use psb_sparse_mod
implicit none
integer :: ictxt
character :: filename*(*)
integer, optional :: inroot
complex(kind(1.0d0)), pointer, optional :: indwork(:)
integer, pointer, optional :: iniwork(:) ! local variables
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
complex(kind(1.0d0)), pointer :: b(:,:)
complex(kind(1.0d0)), allocatable :: b(:,:)
if (present(inroot)) then
root = inroot
else
test/Fileread/zf_sample.f90
+9 -10
View File
@@ -68,9 +68,10 @@ program zf_sample
integer :: igsmth, matop, novr
! dense matrices
complex(kind(1.d0)), pointer :: aux_b(:,:), d(:)
complex(kind(1.d0)), pointer, save :: b_col(:), x_col(:), r_col(:), &
& b_col_glob(:), x_col_glob(:), r_col_glob(:)
complex(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
complex(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& x_col_glob(:), r_col_glob(:)
complex(kind(1.d0)), pointer :: b_col_glob(:)
! communications data structure
type(psb_desc_type):: desc_a
@@ -126,7 +127,6 @@ program zf_sample
nrhs = 1
if (amroot) then
nullify(aux_b)
call readmat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m
@@ -137,14 +137,14 @@ program zf_sample
call read_rhs(rhs_file,aux_b,ictxt)
end if
if (associated(aux_b).and.size(aux_b,1)==m_problem) then
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 ")')
b_col_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
allocate(aux_b(m_problem,1), stat=ircode)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(4000,name)
goto 9999
@@ -158,7 +158,7 @@ program zf_sample
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
allocate(aux_b(m_problem,1), stat=ircode)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(4000,name)
goto 9999
@@ -192,10 +192,9 @@ program zf_sample
if (amroot) then
write(*,'("Partition type: graph")')
write(*,'(" ")')
write(0,'("Build type: graph")')
! write(0,'("Build type: graph")')
call build_grppart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
endif
write(0,'("Done graph build")')
call psb_barrier(ictxt)
call distr_grppart(root,ictxt)
call getv_grppart(ivg)
@@ -284,7 +283,7 @@ program zf_sample
if (amroot) then
call psb_prec_descr(6,pre)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i4," processors")')np
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence: ",i6)')iter
write(*,'("Error indicator on exit: ",f7.2)')err
write(*,'("Time to buil prec. : ",es10.4)')tprec
test/pargen/ppde90.f90
+8 -11
View File
@@ -97,8 +97,8 @@ program pde90
! descriptor
type(psb_desc_type) :: desc_a, desc_a_out
! dense matrices
real(kind(1.d0)), pointer :: b(:), x(:), d(:),ld(:)
integer, pointer :: work(:)
real(kind(1.d0)), allocatable :: b(:), x(:), d(:),ld(:)
integer, allocatable :: work(:)
! blacs parameters
integer :: ictxt, iam, np
@@ -394,12 +394,12 @@ contains
use psb_sparse_mod
implicit none
integer :: idim
integer, parameter :: nbmax=10
real(kind(1.d0)),pointer :: b(:),t(:)
type(psb_desc_type) :: desc_a
integer :: ictxt, info
character :: afmt*5
integer :: idim
integer, parameter :: nbmax=10
real(kind(1.d0)), allocatable :: b(:),t(:)
type(psb_desc_type) :: desc_a
integer :: ictxt, info
character :: afmt*5
interface
! .....user passed subroutine.....
subroutine parts(global_indx,n,np,pv,nv)
@@ -419,9 +419,6 @@ contains
integer, allocatable :: irow(:),icol(:)
real(kind(1.d0)), allocatable :: val(:)
integer, allocatable :: prv(:)
integer, pointer :: ierrv(:)
real(kind(1.d0)), pointer :: dwork(:)
integer,pointer :: iwork(:)
! deltah dimension of each grid cell
! deltat discretization time
real(kind(1.d0)) :: deltah