Adjusted test programs to ALLOCATABLEs.

psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 656eba0524
commit f6655e698d

@ -339,9 +339,9 @@ Contains
function psb_isize1d(vin) function psb_isize1d(vin)
integer :: psb_isize1d integer :: psb_isize1d
integer, pointer :: vin(:) integer, allocatable, intent(in) :: vin(:)
if (.not.associated(vin)) then if (.not.allocated(vin)) then
psb_isize1d = 0 psb_isize1d = 0
else else
psb_isize1d = size(vin) psb_isize1d = size(vin)
@ -349,10 +349,10 @@ Contains
end function psb_isize1d end function psb_isize1d
function psb_isize2d(vin,dim) function psb_isize2d(vin,dim)
integer :: psb_isize2d integer :: psb_isize2d
integer, pointer :: vin(:,:) integer, allocatable, intent(in) :: vin(:,:)
integer, optional :: dim integer, optional :: dim
if (.not.associated(vin)) then if (.not.allocated(vin)) then
psb_isize2d = 0 psb_isize2d = 0
else else
if (present(dim)) then if (present(dim)) then
@ -365,9 +365,9 @@ Contains
function psb_dsize1d(vin) function psb_dsize1d(vin)
integer :: psb_dsize1d integer :: psb_dsize1d
real(kind(1.d0)), pointer :: vin(:) real(kind(1.d0)), allocatable, intent(in) :: vin(:)
if (.not.associated(vin)) then if (.not.allocated(vin)) then
psb_dsize1d = 0 psb_dsize1d = 0
else else
psb_dsize1d = size(vin) psb_dsize1d = size(vin)
@ -375,10 +375,10 @@ Contains
end function psb_dsize1d end function psb_dsize1d
function psb_dsize2d(vin,dim) function psb_dsize2d(vin,dim)
integer :: psb_dsize2d integer :: psb_dsize2d
real(kind(1.d0)), pointer :: vin(:,:) real(kind(1.d0)), allocatable, intent(in) :: vin(:,:)
integer, optional :: dim integer, optional :: dim
if (.not.associated(vin)) then if (.not.allocated(vin)) then
psb_dsize2d = 0 psb_dsize2d = 0
else else
if (present(dim)) then if (present(dim)) then
@ -392,9 +392,9 @@ Contains
function psb_zsize1d(vin) function psb_zsize1d(vin)
integer :: psb_zsize1d integer :: psb_zsize1d
complex(kind(1.d0)), pointer :: vin(:) complex(kind(1.d0)), allocatable, intent(in) :: vin(:)
if (.not.associated(vin)) then if (.not.allocated(vin)) then
psb_zsize1d = 0 psb_zsize1d = 0
else else
psb_zsize1d = size(vin) psb_zsize1d = size(vin)
@ -402,10 +402,10 @@ Contains
end function psb_zsize1d end function psb_zsize1d
function psb_zsize2d(vin,dim) function psb_zsize2d(vin,dim)
integer :: psb_zsize2d integer :: psb_zsize2d
complex(kind(1.d0)), pointer :: vin(:,:) complex(kind(1.d0)), allocatable, intent(in) :: vin(:,:)
integer, optional :: dim integer, optional :: dim
if (.not.associated(vin)) then if (.not.allocated(vin)) then
psb_zsize2d = 0 psb_zsize2d = 0
else else
if (present(dim)) then if (present(dim)) then

@ -68,9 +68,10 @@ program df_sample
integer :: igsmth, matop, novr integer :: igsmth, matop, novr
! dense matrices ! dense matrices
real(kind(1.d0)), pointer :: aux_b(:,:), d(:) real(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
real(kind(1.d0)), pointer, save :: b_col(:), x_col(:), r_col(:), & real(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& b_col_glob(:), x_col_glob(:), r_col_glob(:) & x_col_glob(:), r_col_glob(:)
real(kind(1.d0)), pointer :: b_col_glob(:)
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
@ -125,7 +126,6 @@ program df_sample
nrhs = 1 nrhs = 1
if (amroot) then if (amroot) then
nullify(aux_b)
call readmat(mtrx_file, aux_a, ictxt) call readmat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m m_problem = aux_a%m
@ -136,14 +136,14 @@ program df_sample
call read_rhs(rhs_file,aux_b,ictxt) call read_rhs(rhs_file,aux_b,ictxt)
end if 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 ! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")') write(0,'("Ok, got an rhs ")')
b_col_glob =>aux_b(:,1) b_col_glob =>aux_b(:,1)
else else
write(*,'("Generating an rhs...")') write(*,'("Generating an rhs...")')
write(*,'(" ")') write(*,'(" ")')
allocate(aux_b(m_problem,1), stat=ircode) call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
@ -157,7 +157,7 @@ program df_sample
call psb_bcast(ictxt,b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call psb_bcast(ictxt,m_problem) 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 if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
@ -274,8 +274,8 @@ program df_sample
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,t2)
call psb_geaxpby(1.d0,b_col,0.d0,r_col,desc_a,info) call psb_geaxpby(done,b_col,dzero,r_col,desc_a,info)
call psb_spmm(-1.d0,a,x_col,1.d0,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_genrm2s(resmx,r_col,desc_a,info)
call psb_geamaxs(resmxp,r_col,desc_a,info) call psb_geamaxs(resmxp,r_col,desc_a,info)

@ -82,11 +82,11 @@ contains
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : the updated array descriptor ! 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 entry: this contains right hand side.
! on exit : ! on exit :
! !
! real(kind(1.d0)), pointer, optional :: b(:) ! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : this will contain the local right hand side. ! on exit : this will contain the local right hand side.
! !
@ -99,10 +99,10 @@ contains
! parameters ! parameters
type(psb_dspmat_type) :: a_glob type(psb_dspmat_type) :: a_glob
real(kind(1.d0)), pointer :: b_glob(:) real(kind(1.d0)) :: b_glob(:)
integer :: ictxt integer :: ictxt
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
real(kind(1.d0)), pointer :: b(:) real(kind(1.d0)), allocatable :: b(:)
type (psb_desc_type) :: desc_a type (psb_desc_type) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional :: inroot integer, optional :: inroot
@ -123,7 +123,7 @@ contains
integer :: ircode, length_row, i_count, j_count,& integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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 character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(kind(1.d0)), allocatable :: val(:) real(kind(1.d0)), allocatable :: val(:)
@ -530,11 +530,11 @@ contains
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : the updated array descriptor ! 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 entry: this contains right hand side.
! on exit : ! on exit :
! !
! real(kind(1.d0)), pointer, optional :: b(:) ! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : this will contain the local right hand side. ! on exit : this will contain the local right hand side.
! !
@ -545,10 +545,10 @@ contains
use psb_sparse_mod use psb_sparse_mod
implicit none ! parameters implicit none ! parameters
type(psb_dspmat_type) :: a_glob type(psb_dspmat_type) :: a_glob
real(kind(1.d0)), pointer :: b_glob(:) real(kind(1.d0)) :: b_glob(:)
integer :: ictxt, v(:) integer :: ictxt, v(:)
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
real(kind(1.d0)), pointer :: b(:) real(kind(1.d0)), allocatable :: b(:)
type (psb_desc_type) :: desc_a type (psb_desc_type) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional :: inroot integer, optional :: inroot
@ -558,7 +558,7 @@ contains
integer :: ircode, length_row, i_count, j_count,& integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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 character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(kind(1.d0)), allocatable :: val(:) real(kind(1.d0)), allocatable :: val(:)
@ -857,11 +857,11 @@ contains
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : the updated array descriptor ! 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 entry: this contains right hand side.
! on exit : ! on exit :
! !
! real(kind(1.d0)), pointer, optional :: b(:) ! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : this will contain the local right hand side. ! on exit : this will contain the local right hand side.
! !
@ -874,10 +874,10 @@ contains
! parameters ! parameters
type(psb_zspmat_type) :: a_glob type(psb_zspmat_type) :: a_glob
complex(kind(1.d0)), pointer :: b_glob(:) complex(kind(1.d0)) :: b_glob(:)
integer :: ictxt integer :: ictxt
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
complex(kind(1.d0)), pointer :: b(:) complex(kind(1.d0)), allocatable :: b(:)
type (psb_desc_type) :: desc_a type (psb_desc_type) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional :: inroot integer, optional :: inroot
@ -898,7 +898,7 @@ contains
integer :: ircode, length_row, i_count, j_count,& integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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 character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
complex(kind(1.d0)), allocatable :: val(:) complex(kind(1.d0)), allocatable :: val(:)
@ -1302,11 +1302,11 @@ contains
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : the updated array descriptor ! 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 entry: this contains right hand side.
! on exit : ! on exit :
! !
! real(kind(1.d0)), pointer, optional :: b(:) ! real(kind(1.d0)), allocatable, optional :: b(:)
! on entry: fresh variable. ! on entry: fresh variable.
! on exit : this will contain the local right hand side. ! on exit : this will contain the local right hand side.
! !
@ -1317,10 +1317,10 @@ contains
use psb_sparse_mod use psb_sparse_mod
implicit none ! parameters implicit none ! parameters
type(psb_zspmat_type) :: a_glob type(psb_zspmat_type) :: a_glob
complex(kind(1.d0)), pointer :: b_glob(:) complex(kind(1.d0)) :: b_glob(:)
integer :: ictxt, v(:) integer :: ictxt, v(:)
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
complex(kind(1.d0)), pointer :: b(:) complex(kind(1.d0)), allocatable :: b(:)
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
integer, optional :: inroot integer, optional :: inroot
@ -1330,7 +1330,7 @@ contains
integer :: ircode, length_row, i_count, j_count,& integer :: ircode, length_row, i_count, j_count,&
& k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,& & k_count, blockdim, root, liwork, nrow, ncol, nnzero, nrhs,&
& i,j,k, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) & 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 character :: afmt*5, atyp*5
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
complex(kind(1.d0)), allocatable :: val(:) complex(kind(1.d0)), allocatable :: val(:)

@ -57,12 +57,6 @@
! On Entry: Index of root processor (default: 0) ! On Entry: Index of root processor (default: 0)
! On Exit : unchanged. ! 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 module read_mat
interface readmat interface readmat
module procedure dreadmat, zreadmat module procedure dreadmat, zreadmat
@ -104,20 +98,17 @@ contains
end subroutine dreadmat end subroutine dreadmat
subroutine dread_rhs (filename, b, ictxt, inroot,& subroutine dread_rhs (filename, b, ictxt, inroot)
& indwork, iniwork)
use psb_sparse_mod use psb_sparse_mod
implicit none implicit none
integer :: ictxt integer :: ictxt
character :: filename*(*) character :: filename*(*)
integer, optional :: inroot integer, optional :: inroot
real(kind(1.0d0)), pointer, optional :: indwork(:)
integer, pointer, optional :: iniwork(:) ! local variables
integer, parameter :: infile = 2 integer, parameter :: infile = 2
integer :: nrow, ncol, i,root, nprow, npcol, myprow, mypcol, ircode, j integer :: nrow, ncol, i,root, nprow, npcol, myprow, mypcol, ircode, j
character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& character :: mmheader*15, fmt*15, object*10, type*10, sym*15,&
& line*1024 & line*1024
real(kind(1.0d0)), pointer :: b(:,:) real(kind(1.0d0)), allocatable :: b(:,:)
if (present(inroot)) then if (present(inroot)) then
root = inroot root = inroot
else else
@ -195,20 +186,17 @@ contains
end subroutine zreadmat end subroutine zreadmat
subroutine zread_rhs (filename, b, ictxt, inroot,& subroutine zread_rhs (filename, b, ictxt, inroot)
& indwork, iniwork)
use psb_sparse_mod use psb_sparse_mod
implicit none implicit none
integer :: ictxt integer :: ictxt
character :: filename*(*) character :: filename*(*)
integer, optional :: inroot integer, optional :: inroot
complex(kind(1.0d0)), pointer, optional :: indwork(:)
integer, pointer, optional :: iniwork(:) ! local variables
integer, parameter :: infile = 2 integer, parameter :: infile = 2
integer :: nrow, ncol, i,root, nprow, npcol, myprow, mypcol, ircode, j integer :: nrow, ncol, i,root, nprow, npcol, myprow, mypcol, ircode, j
character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& character :: mmheader*15, fmt*15, object*10, type*10, sym*15,&
& line*1024 & line*1024
complex(kind(1.0d0)), pointer :: b(:,:) complex(kind(1.0d0)), allocatable :: b(:,:)
if (present(inroot)) then if (present(inroot)) then
root = inroot root = inroot
else else

@ -68,9 +68,10 @@ program zf_sample
integer :: igsmth, matop, novr integer :: igsmth, matop, novr
! dense matrices ! dense matrices
complex(kind(1.d0)), pointer :: aux_b(:,:), d(:) complex(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
complex(kind(1.d0)), pointer, save :: b_col(:), x_col(:), r_col(:), & complex(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
& b_col_glob(:), x_col_glob(:), r_col_glob(:) & x_col_glob(:), r_col_glob(:)
complex(kind(1.d0)), pointer :: b_col_glob(:)
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
@ -126,7 +127,6 @@ program zf_sample
nrhs = 1 nrhs = 1
if (amroot) then if (amroot) then
nullify(aux_b)
call readmat(mtrx_file, aux_a, ictxt) call readmat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m m_problem = aux_a%m
@ -137,14 +137,14 @@ program zf_sample
call read_rhs(rhs_file,aux_b,ictxt) call read_rhs(rhs_file,aux_b,ictxt)
end if 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 ! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")') write(0,'("Ok, got an rhs ")')
b_col_glob =>aux_b(:,1) b_col_glob =>aux_b(:,1)
else else
write(*,'("Generating an rhs...")') write(*,'("Generating an rhs...")')
write(*,'(" ")') write(*,'(" ")')
allocate(aux_b(m_problem,1), stat=ircode) call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
@ -158,7 +158,7 @@ program zf_sample
call psb_bcast(ictxt,b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call psb_bcast(ictxt,m_problem) 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 if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
@ -192,10 +192,9 @@ program zf_sample
if (amroot) then if (amroot) then
write(*,'("Partition type: graph")') write(*,'("Partition type: graph")')
write(*,'(" ")') 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) call build_grppart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
endif endif
write(0,'("Done graph build")')
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)
@ -284,7 +283,7 @@ program zf_sample
if (amroot) then if (amroot) then
call psb_prec_descr(6,pre) call psb_prec_descr(6,pre)
write(*,'("Matrix: ",a)')mtrx_file 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(*,'("Iterations to convergence: ",i6)')iter
write(*,'("Error indicator on exit: ",f7.2)')err write(*,'("Error indicator on exit: ",f7.2)')err
write(*,'("Time to buil prec. : ",es10.4)')tprec write(*,'("Time to buil prec. : ",es10.4)')tprec

@ -97,8 +97,8 @@ program pde90
! descriptor ! descriptor
type(psb_desc_type) :: desc_a, desc_a_out type(psb_desc_type) :: desc_a, desc_a_out
! dense matrices ! dense matrices
real(kind(1.d0)), pointer :: b(:), x(:), d(:),ld(:) real(kind(1.d0)), allocatable :: b(:), x(:), d(:),ld(:)
integer, pointer :: work(:) integer, allocatable :: work(:)
! blacs parameters ! blacs parameters
integer :: ictxt, iam, np integer :: ictxt, iam, np
@ -394,12 +394,12 @@ contains
use psb_sparse_mod use psb_sparse_mod
implicit none implicit none
integer :: idim integer :: idim
integer, parameter :: nbmax=10 integer, parameter :: nbmax=10
real(kind(1.d0)),pointer :: b(:),t(:) real(kind(1.d0)), allocatable :: b(:),t(:)
type(psb_desc_type) :: desc_a type(psb_desc_type) :: desc_a
integer :: ictxt, info integer :: ictxt, info
character :: afmt*5 character :: afmt*5
interface interface
! .....user passed subroutine..... ! .....user passed subroutine.....
subroutine parts(global_indx,n,np,pv,nv) subroutine parts(global_indx,n,np,pv,nv)
@ -419,9 +419,6 @@ contains
integer, allocatable :: irow(:),icol(:) integer, allocatable :: irow(:),icol(:)
real(kind(1.d0)), allocatable :: val(:) real(kind(1.d0)), allocatable :: val(:)
integer, allocatable :: prv(:) integer, allocatable :: prv(:)
integer, pointer :: ierrv(:)
real(kind(1.d0)), pointer :: dwork(:)
integer,pointer :: iwork(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(kind(1.d0)) :: deltah real(kind(1.d0)) :: deltah

Loading…
Cancel
Save