From a38f24d8a292c4c6c4344d05b144ce63e69fdd57 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 15 Nov 2007 15:19:27 +0000 Subject: [PATCH] Set default to psb_root_ . --- base/comm/psb_dgather.f90 | 2 +- base/comm/psb_dscatter.F90 | 4 ++-- base/comm/psb_igather.f90 | 2 +- base/comm/psb_iscatter.F90 | 4 ++-- base/comm/psb_zgather.f90 | 4 ++-- base/comm/psb_zscatter.F90 | 4 ++-- base/internals/psi_crea_index.f90 | 2 +- base/modules/psb_penv_mod.F90 | 27 ++++++++++++----------- prec/psb_ddiagsc_bld.f90 | 2 +- prec/psb_dprecbld.f90 | 2 +- prec/psb_zdiagsc_bld.f90 | 2 +- prec/psb_zprecbld.f90 | 2 +- test/fileread/df_sample.f90 | 29 +++++++++++-------------- test/fileread/zf_sample.f90 | 29 +++++++++++-------------- test/pargen/ppde.f90 | 36 +++++++++++++++---------------- util/psb_mat_dist_mod.f90 | 8 +++---- util/psb_read_mat_mod.f90 | 8 +++---- 17 files changed, 81 insertions(+), 86 deletions(-) diff --git a/base/comm/psb_dgather.f90 b/base/comm/psb_dgather.f90 index f4516a49..37574474 100644 --- a/base/comm/psb_dgather.f90 +++ b/base/comm/psb_dgather.f90 @@ -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 diff --git a/base/comm/psb_dscatter.F90 b/base/comm/psb_dscatter.F90 index 54991db2..c34c4744 100644 --- a/base/comm/psb_dscatter.F90 +++ b/base/comm/psb_dscatter.F90 @@ -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 diff --git a/base/comm/psb_igather.f90 b/base/comm/psb_igather.f90 index 72efe3eb..b3d330c1 100644 --- a/base/comm/psb_igather.f90 +++ b/base/comm/psb_igather.f90 @@ -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 diff --git a/base/comm/psb_iscatter.F90 b/base/comm/psb_iscatter.F90 index 295c6ac9..c3fa71f1 100644 --- a/base/comm/psb_iscatter.F90 +++ b/base/comm/psb_iscatter.F90 @@ -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 diff --git a/base/comm/psb_zgather.f90 b/base/comm/psb_zgather.f90 index df51f14a..dca3fbd1 100644 --- a/base/comm/psb_zgather.f90 +++ b/base/comm/psb_zgather.f90 @@ -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 diff --git a/base/comm/psb_zscatter.F90 b/base/comm/psb_zscatter.F90 index 8f4e4f5b..29613eb3 100644 --- a/base/comm/psb_zscatter.F90 +++ b/base/comm/psb_zscatter.F90 @@ -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 diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index fe5051d1..a0b664ea 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -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 diff --git a/base/modules/psb_penv_mod.F90 b/base/modules/psb_penv_mod.F90 index 30592bc2..a4221f42 100644 --- a/base/modules/psb_penv_mod.F90 +++ b/base/modules/psb_penv_mod.F90 @@ -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) diff --git a/prec/psb_ddiagsc_bld.f90 b/prec/psb_ddiagsc_bld.f90 index aab70746..8a46c65b 100644 --- a/prec/psb_ddiagsc_bld.f90 +++ b/prec/psb_ddiagsc_bld.f90 @@ -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 diff --git a/prec/psb_dprecbld.f90 b/prec/psb_dprecbld.f90 index 7feb6603..304924ea 100644 --- a/prec/psb_dprecbld.f90 +++ b/prec/psb_dprecbld.f90 @@ -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 diff --git a/prec/psb_zdiagsc_bld.f90 b/prec/psb_zdiagsc_bld.f90 index aa2e4927..0e5b7784 100644 --- a/prec/psb_zdiagsc_bld.f90 +++ b/prec/psb_zdiagsc_bld.f90 @@ -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 diff --git a/prec/psb_zprecbld.f90 b/prec/psb_zprecbld.f90 index 4f1f53bd..36a20ab6 100644 --- a/prec/psb_zprecbld.f90 +++ b/prec/psb_zprecbld.f90 @@ -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 diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index 984ae17c..8b8ef6c0 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -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 diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index b4da2e79..030567f7 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -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 diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index 4047450e..f9681c78 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -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) diff --git a/util/psb_mat_dist_mod.f90 b/util/psb_mat_dist_mod.f90 index 31d2f0f1..5c6c9de5 100644 --- a/util/psb_mat_dist_mod.f90 +++ b/util/psb_mat_dist_mod.f90 @@ -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) diff --git a/util/psb_read_mat_mod.f90 b/util/psb_read_mat_mod.f90 index a469a3ea..3b339974 100644 --- a/util/psb_read_mat_mod.f90 +++ b/util/psb_read_mat_mod.f90 @@ -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