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

Set default to psb_root_ .

Browse Source
This commit is contained in:
Salvatore Filippone
2007-11-15 15:19:27 +00:00
parent d2ad1ed196
commit a38f24d8a2
17 changed files with 81 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/psb_dgather.f90
+1 -1
View File
@@ -92,7 +92,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
root = -1
end if
if (root==-1) then
iiroot=0
iiroot = psb_root_
else
iiroot = root
endif
base/comm/psb_dscatter.F90
+2 -2
View File
@@ -98,8 +98,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
else
root = -1
end if
if (root==-1) then
iiroot=0
if (root == -1) then
iiroot = psb_root_
endif
iglobx = 1
base/comm/psb_igather.f90
+1 -1
View File
@@ -92,7 +92,7 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
root = -1
end if
if (root==-1) then
iiroot=0
iiroot = psb_root_
else
iiroot = root
endif
base/comm/psb_iscatter.F90
+2 -2
View File
@@ -97,8 +97,8 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
else
root = -1
end if
if (root==-1) then
iiroot=0
if (root == -1) then
iiroot = psb_root_
endif
iglobx = 1
base/comm/psb_zgather.f90
+2 -2
View File
@@ -91,8 +91,8 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot)
else
root = -1
end if
if (root==-1) then
iiroot=0
if (root == -1) then
iiroot = psb_root_
else
iiroot = root
endif
base/comm/psb_zscatter.F90
+2 -2
View File
@@ -98,8 +98,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
else
root = -1
end if
if (root==-1) then
iiroot=0
if (root == -1) then
iiroot = psb_root_
endif
base/internals/psi_crea_index.f90
+1 -1
View File
@@ -70,7 +70,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
integer :: ictxt, me, np, mode, err_act, dl_lda
! ...parameters...
integer, allocatable :: dep_list(:,:), length_dl(:)
integer,parameter :: root=0,no_comm=-1
integer,parameter :: root=psb_root_,no_comm=-1
logical,parameter :: debug=.false.
character(len=20) :: name
base/modules/psb_penv_mod.F90
+14 -13
View File
@@ -41,7 +41,8 @@ end module mpi
#endif
module psb_penv_mod
use psb_const_mod
interface psb_init
module procedure psb_init
@@ -303,7 +304,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -327,7 +328,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -351,7 +352,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -376,7 +377,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -401,7 +402,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -425,7 +426,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -450,7 +451,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -474,7 +475,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -498,7 +499,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -529,7 +530,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
if (present(length)) then
length_ = length
@@ -562,7 +563,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
@@ -590,7 +591,7 @@ contains
if (present(root)) then
root_ = root
else
root_ = 0
root_ = psb_root_
endif
call psb_info(ictxt,iam,np)
prec/psb_ddiagsc_bld.f90
+1 -1
View File
@@ -48,7 +48,7 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
integer :: int_err(5)
logical, parameter :: debug=.false.
integer,parameter :: iroot=0,iout=60,ilout=40
integer,parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
prec/psb_dprecbld.f90
+1 -1
View File
@@ -47,7 +47,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
character :: iupd
logical, parameter :: debug=.false.
integer,parameter :: iroot=0,iout=60,ilout=40
integer,parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
prec/psb_zdiagsc_bld.f90
+1 -1
View File
@@ -48,7 +48,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
integer :: int_err(5)
logical, parameter :: debug=.false.
integer,parameter :: iroot=0,iout=60,ilout=40
integer,parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
prec/psb_zprecbld.f90
+1 -1
View File
@@ -49,7 +49,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
character :: iupd
logical, parameter :: debug=.false.
integer,parameter :: iroot=0,iout=60,ilout=40
integer,parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return
test/fileread/df_sample.f90
+13 -16
View File
@@ -55,8 +55,6 @@ program df_sample
type(psb_desc_type):: desc_a
integer :: ictxt, iam, np
logical :: amroot
integer, parameter :: root=0
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
@@ -84,11 +82,10 @@ program df_sample
call psb_exit(ictxt)
stop
endif
amroot = (iam==root)
name='df_sample'
if(psb_get_errstatus().ne.0) goto 9999
if(psb_get_errstatus() /= 0) goto 9999
info=0
call psb_set_errverbosity(2)
call psb_set_erraction(0)
@@ -103,7 +100,7 @@ program df_sample
! read the input matrix to be processed and (possibly) the rhs
nrhs = 1
if (amroot) then
if (iam==psb_root_) then
call read_mat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m
@@ -147,7 +144,7 @@ program df_sample
! switch over different partition types
if (ipart.eq.0) then
call psb_barrier(ictxt)
if (amroot) write(*,'("Partition type: block")')
if (iam==psb_root_) write(*,'("Partition type: block")')
allocate(ivg(m_problem),ipv(np))
do i=1,m_problem
call part_block(i,m_problem,np,ipv,nv)
@@ -156,19 +153,19 @@ program df_sample
call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
else if (ipart.eq.2) then
if (amroot) then
if (iam==psb_root_) then
write(*,'("Partition type: graph")')
write(*,'(" ")')
! write(0,'("Build type: graph")')
call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
endif
call psb_barrier(ictxt)
call distr_mtpart(root,ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
else
if (amroot) write(*,'("Partition type: block")')
if (iam==psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_a, a, part_block, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
end if
@@ -184,7 +181,7 @@ program df_sample
call psb_amx(ictxt, t2)
if (amroot) then
if (iam==psb_root_) then
write(*,'(" ")')
write(*,'("Time to read and partition matrix : ",es10.4)')t2
write(*,'(" ")')
@@ -206,7 +203,7 @@ program df_sample
call psb_amx(ictxt, tprec)
if(amroot) then
if(iam==psb_root_) then
write(*,'("Preconditioner time: ",es10.4)')tprec
write(*,'(" ")')
end if
@@ -231,7 +228,7 @@ program df_sample
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (amroot) then
if (iam==psb_root_) then
call psb_prec_descr(6,prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
@@ -249,12 +246,12 @@ program df_sample
end if
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)
if (ierr.ne.0) then
if (ierr /= 0) then
write(0,*) 'allocation error: no data collection'
else
call psb_gather(x_col_glob,x_col,desc_a,info,root=0)
call psb_gather(r_col_glob,r_col,desc_a,info,root=0)
if (amroot) then
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
if (iam==psb_root_) then
write(0,'(" ")')
write(0,'("Saving x on file")')
write(20,*) 'matrix: ',mtrx_file
test/fileread/zf_sample.f90
+13 -16
View File
@@ -55,8 +55,6 @@ program zf_sample
type(psb_desc_type):: desc_a
integer :: ictxt, iam, np
logical :: amroot
integer, parameter :: root=0
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
@@ -84,11 +82,10 @@ program zf_sample
call psb_exit(ictxt)
stop
endif
amroot = (iam==root)
name='zf_sample'
if(psb_get_errstatus().ne.0) goto 9999
if(psb_get_errstatus() /= 0) goto 9999
info=0
call psb_set_errverbosity(2)
call psb_set_erraction(0)
@@ -103,7 +100,7 @@ program zf_sample
! read the input matrix to be processed and (possibly) the rhs
nrhs = 1
if (amroot) then
if (iam==psb_root_) then
call read_mat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m
@@ -147,7 +144,7 @@ program zf_sample
! switch over different partition types
if (ipart.eq.0) then
call psb_barrier(ictxt)
if (amroot) write(*,'("Partition type: block")')
if (iam==psb_root_) write(*,'("Partition type: block")')
allocate(ivg(m_problem),ipv(np))
do i=1,m_problem
call part_block(i,m_problem,np,ipv,nv)
@@ -156,19 +153,19 @@ program zf_sample
call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
else if (ipart.eq.2) then
if (amroot) then
if (iam==psb_root_) then
write(*,'("Partition type: graph")')
write(*,'(" ")')
! write(0,'("Build type: graph")')
call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
endif
call psb_barrier(ictxt)
call distr_mtpart(root,ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
else
if (amroot) write(*,'("Partition type: block")')
if (iam==psb_root_) write(*,'("Partition type: block")')
call psb_matdist(aux_a, a, part_block, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt)
end if
@@ -184,7 +181,7 @@ program zf_sample
call psb_amx(ictxt, t2)
if (amroot) then
if (iam==psb_root_) then
write(*,'(" ")')
write(*,'("Time to read and partition matrix : ",es10.4)')t2
write(*,'(" ")')
@@ -206,7 +203,7 @@ program zf_sample
call psb_amx(ictxt,tprec)
if(amroot) then
if(iam==psb_root_) then
write(*,'("Preconditioner time: ",es10.4)')tprec
write(*,'(" ")')
end if
@@ -230,7 +227,7 @@ program zf_sample
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (amroot) then
if (iam==psb_root_) then
call psb_prec_descr(6,prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
@@ -248,12 +245,12 @@ program zf_sample
end if
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)
if (ierr.ne.0) then
if (ierr /= 0) then
write(0,*) 'allocation error: no data collection'
else
call psb_gather(x_col_glob,x_col,desc_a,info,root=0)
call psb_gather(r_col_glob,r_col,desc_a,info,root=0)
if (amroot) then
call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_)
call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_)
if (iam==psb_root_) then
write(0,'(" ")')
write(0,'("Saving x on file")')
write(20,*) 'matrix: ',mtrx_file
test/pargen/ppde.f90
+18 -18
View File
@@ -104,7 +104,7 @@ program ppde
integer :: info
character(len=20) :: name,ch_err
if(psb_get_errstatus().ne.0) goto 9999
if(psb_get_errstatus() /= 0) goto 9999
info=0
name='pde90'
call psb_set_errverbosity(2)
@@ -133,7 +133,7 @@ program ppde
t1 = psb_wtime()
call create_matrix(idim,a,b,x,desc_a,part_block,ictxt,afmt,info)
t2 = psb_wtime() - t1
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='create_matrix'
call psb_errpush(info,name,a_err=ch_err)
@@ -141,8 +141,8 @@ program ppde
end if
call psb_amx(ictxt,t2)
if (iam == 0) write(*,'("Overall matrix creation time : ",es10.4)')t2
if (iam == 0) write(*,'(" ")')
if (iam == psb_root_) write(*,'("Overall matrix creation time : ",es10.4)')t2
if (iam == psb_root_) write(*,'(" ")')
!
! prepare the preconditioner.
!
@@ -153,7 +153,7 @@ program ppde
call psb_barrier(ictxt)
t1 = psb_wtime()
call psb_precbld(a,desc_a,prec,info)
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
@@ -164,8 +164,8 @@ program ppde
call psb_amx(ictxt,tprec)
if (iam == 0) write(*,'("Preconditioner time : ",es10.4)')tprec
if (iam == 0) write(*,'(" ")')
if (iam == psb_root_) write(*,'("Preconditioner time : ",es10.4)')tprec
if (iam == psb_root_) write(*,'(" ")')
!
! iterative method parameters
@@ -177,7 +177,7 @@ program ppde
call psb_krylov(kmethd,a,prec,b,x,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='solver routine'
call psb_errpush(info,name,a_err=ch_err)
@@ -188,7 +188,7 @@ program ppde
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
if (iam == 0) then
if (iam == psb_root_) then
write(*,'(" ")')
write(*,'("Time to solve matrix : ",es10.4)')t2
write(*,'("Time per iteration : ",es10.4)')t2/iter
@@ -205,7 +205,7 @@ program ppde
call psb_spfree(a,desc_a,info)
call psb_precfree(prec,info)
call psb_cdfree(desc_a,info)
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='free routine'
call psb_errpush(info,name,a_err=ch_err)
@@ -403,7 +403,7 @@ contains
! define rhs from boundary conditions; also build initial guess
call psb_geall(b,desc_a,info)
call psb_geall(xv,desc_a,info)
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='allocation rout.'
call psb_errpush(info,name,a_err=ch_err)
@@ -416,7 +416,7 @@ contains
!
allocate(val(20*nbmax),irow(20*nbmax),&
&icol(20*nbmax),prv(np),stat=info)
if (info.ne.0 ) then
if (info /= 0 ) then
info=4000
call psb_errpush(info,name)
goto 9999
@@ -554,13 +554,13 @@ contains
t3 = psb_wtime()
call psb_spins(element-1,irow,icol,val,a,desc_a,info)
if(info.ne.0) exit
if(info /= 0) exit
tins = tins + (psb_wtime()-t3)
call psb_geins(1,(/ia/),zt(1:1),b,desc_a,info)
if(info.ne.0) exit
if(info /= 0) exit
zt(1)=0.d0
call psb_geins(1,(/ia/),zt(1:1),xv,desc_a,info)
if(info.ne.0) exit
if(info /= 0) exit
end if
end do
end do
@@ -568,7 +568,7 @@ contains
call psb_barrier(ictxt)
t2 = psb_wtime()-t1
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='insert rout.'
call psb_errpush(info,name,a_err=ch_err)
@@ -582,7 +582,7 @@ contains
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_barrier(ictxt)
tasb = psb_wtime()-t1
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='asb rout.'
call psb_errpush(info,name,a_err=ch_err)
@@ -603,7 +603,7 @@ contains
call psb_geasb(b,desc_a,info)
call psb_geasb(xv,desc_a,info)
if(info.ne.0) then
if(info /= 0) then
info=4010
ch_err='asb rout.'
call psb_errpush(info,name,a_err=ch_err)
util/psb_mat_dist_mod.f90
+4 -4
View File
@@ -141,7 +141,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, iam, np)
if (iam == root) then
@@ -551,7 +551,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, iam, np)
@@ -887,7 +887,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, iam, np)
if (iam == root) then
@@ -1296,7 +1296,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, iam, np)
util/psb_read_mat_mod.f90
+4 -4
View File
@@ -82,7 +82,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, me, np)
if (me == root) then
@@ -112,7 +112,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, me, np)
if (me == root) then
@@ -170,7 +170,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, me, np)
if (me == root) then
@@ -201,7 +201,7 @@ contains
if (present(inroot)) then
root = inroot
else
root = 0
root = psb_root_
end if
call psb_info(ictxt, me, np)
if (me == root) then