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

took out problem that causes bug and other func calls that arent needed for this current test

Browse Source
scr-persistent-collective
Soren Rasmussen 6 years ago
parent 84c52822f0
commit 47325ab9ee
1 changed files with 96 additions and 84 deletions
Show Stats Download Patch File Download Diff File

180
test/fileread/psb_halo_df_test.f90
Unescape Escape View File

@ -29,6 +29,8 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
program psb_df_sample
use psb_base_mod
use psb_prec_mod
@ -74,13 +76,14 @@ program psb_df_sample
integer(psb_ipk_) :: internal, m,ii,nnzero
real(psb_dpk_) :: t1, t2, tprec
real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp
integer(psb_ipk_) :: nrhs, nrow, n_row, dim, ne, nv
integer(psb_ipk_) :: nrhs, nrow, n_row, dim, ne, nv, ncol
integer(psb_ipk_), allocatable :: ivg(:), perm(:)
integer(psb_ipk_), allocatable :: ipv(:)
character(len=40) :: fname, fnout
! persistant communication
integer(psb_ipk_), allocatable :: iv(:), xa(:)
integer(psb_lpk_), allocatable :: iv(:)
real(psb_dpk_), allocatable :: xa(:)
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
@ -176,6 +179,11 @@ program psb_df_sample
case('BLOCK')
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block)
print *, "---ARTLESS: after psb_matdist1"
! call desc_a%cd_get_list
! call desc_a%cd_v_get_list
! print *, "desc_a%v_halo_index", desc_a%v_get_list()
case('GRAPH')
if (iam == psb_root_) then
@ -193,26 +201,29 @@ program psb_df_sample
case default
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,parts=part_block)
end select
end select
call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
! call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
call psb_geall(x_col,desc_a,info)
call x_col%zero() ! change to mpi rank? Artless
!
nrow=desc_a%get_local_rows()
ncol=desc_a%get_local_cols()
iv = [ (i,i=1,ncol)]
call loc_to_glob(iv,desc_a,info) ! call desc_a%loc_to_glob(iv,info)
! call psb_loc_to_glob(iv,desc_a,info) !
call desc_a%l2gv1(iv,info)
! call desc_a%locgv1(iv,info)
xa(1:nrow) = iv(1:nrow)
xa = iv ! error
xa(nrow+1:ncol) = 0.0
call x_col%set(xa)
call x_col%set_vect(xa)
call psb_halo(x_col,desc_a,info)
ha = x_col%get_vect() ! ha = x_col%get_vect()
xa = x_col%get_vect() ! ha = x_col%get_vect()
do i=nrow+1,ncol
if (ha(i) /= iv(i)) then
write(0,*) 'Mismatch ',i,ha(i),iv(i)
if (xa(i) /= iv(i)) then ! ha
write(0,*) 'Mismatch ',i,xa(i),iv(i) ! ha
end if
end do
@ -235,92 +246,93 @@ program psb_df_sample
!
call prec%init(ictxt,ptype,info)
! call prec%init(ictxt,ptype,info)
! building the preconditioner
t1 = psb_wtime()
call prec%build(a,desc_a,info)
tprec = psb_wtime()-t1
! call prec%build(a,desc_a,info)
! tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
call psb_amx(ictxt,tprec)
if(iam == psb_root_) then
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec
write(psb_out_unit,'(" ")')
end if
cond = dzero
iparm = 0
call psb_barrier(ictxt)
t1 = psb_wtime()
call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,&
& istop=istopc,irst=irst,cond=cond)
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
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)
resmx = psb_genrm2(r_col,desc_a,info)
resmxp = psb_geamax(r_col,desc_a,info)
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = prec%sizeof()
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (iam == psb_root_) then
call prec%descr()
write(psb_out_unit,'("Matrix: ",a)')mtrx_file
write(psb_out_unit,'("Computed solution on ",i8," processors")')np
write(psb_out_unit,'("Iterations to convergence: ",i6)')iter
write(psb_out_unit,'("Error estimate on exit : ",es12.5)') err
write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec
write(psb_out_unit,'("Time to solve system : ",es12.5)')t2
write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter)
write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
write(psb_out_unit,'("Condition number : ",es12.5)')cond
write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
write(psb_out_unit,'("Storage format for A : ",a)')&
& a%get_fmt()
write(psb_out_unit,'("Storage format for DESC_A : ",a)')&
& desc_a%get_fmt()
end if
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
if (info == psb_success_) &
& call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
if (info /= psb_success_) goto 9999
if (iam == psb_root_) then
write(psb_err_unit,'(" ")')
write(psb_err_unit,'("Saving x on file")')
write(20,*) 'matrix: ',mtrx_file
write(20,*) 'computed solution on ',np,' processors.'
write(20,*) 'iterations to convergence: ',iter
write(20,*) 'error estimate (infinity norm) on exit:', &
& ' ||r||/(||a||||x||+||b||) = ',err
write(20,'("Residual norm 2 : ",es12.5)')resmx
write(20,'("Residual norm inf : ",es12.5)')resmxp
write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)'
do i=1,m_problem
write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i)
enddo
end if
! call psb_amx(ictxt,tprec)
! if(iam == psb_root_) then
! write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec
! write(psb_out_unit,'(" ")')
! end if
! cond = dzero
! iparm = 0
! call psb_barrier(ictxt)
! t1 = psb_wtime()
! call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,&
! & itmax=itmax,iter=iter,err=err,itrace=itrace,&
! & istop=istopc,irst=irst,cond=cond)
! call psb_barrier(ictxt)
! t2 = psb_wtime() - t1
! call psb_amx(ictxt,t2)
! 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)
! resmx = psb_genrm2(r_col,desc_a,info)
! resmxp = psb_geamax(r_col,desc_a,info)
! amatsize = a%sizeof()
! descsize = desc_a%sizeof()
! precsize = prec%sizeof()
! call psb_sum(ictxt,amatsize)
! call psb_sum(ictxt,descsize)
! call psb_sum(ictxt,precsize)
! if (iam == psb_root_) then
! call prec%descr()
! write(psb_out_unit,'("Matrix: ",a)')mtrx_file
! write(psb_out_unit,'("Computed solution on ",i8," processors")')np
! write(psb_out_unit,'("Iterations to convergence: ",i6)')iter
! write(psb_out_unit,'("Error estimate on exit : ",es12.5)') err
! write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec
! write(psb_out_unit,'("Time to solve system : ",es12.5)')t2
! write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter)
! write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec
! write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
! write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
! write(psb_out_unit,'("Condition number : ",es12.5)')cond
! write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize
! write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
! write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
! write(psb_out_unit,'("Storage format for A : ",a)')&
! & a%get_fmt()
! write(psb_out_unit,'("Storage format for DESC_A : ",a)')&
! & desc_a%get_fmt()
! end if
! call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
! if (info == psb_success_) &
! & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
! if (info /= psb_success_) goto 9999
! if (iam == psb_root_) then
! write(psb_err_unit,'(" ")')
! write(psb_err_unit,'("Saving x on file")')
! write(20,*) 'matrix: ',mtrx_file
! write(20,*) 'computed solution on ',np,' processors.'
! write(20,*) 'iterations to convergence: ',iter
! write(20,*) 'error estimate (infinity norm) on exit:', &
! & ' ||r||/(||a||||x||+||b||) = ',err
! write(20,'("Residual norm 2 : ",es12.5)')resmx
! write(20,'("Residual norm inf : ",es12.5)')resmxp
! write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)'
! do i=1,m_problem
! write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i)
! enddo
! end if
998 format(i8,4(2x,g20.14))
993 format(i6,4(1x,e12.6))
call psb_gefree(b_col, desc_a,info)
! call psb_gefree(b_col, desc_a,info)
call psb_gefree(x_col, desc_a,info)
call psb_spfree(a, desc_a,info)
call prec%free(info)

Write Preview
Loading…
Cancel
Save