From 9ad5ffe8a664ca8ce3cf3932be22504976f0bb2f Mon Sep 17 00:00:00 2001 From: Alfredo Buttari Date: Mon, 10 Oct 2005 15:39:42 +0000 Subject: [PATCH] *** empty log message *** --- src/methd/psb_dcgstab.f90 | 2 +- src/psblas/psb_dnrm2.f90 | 1 + test/Fileread/RUNS/rtst.inp | 8 ++-- test/Fileread/df_sample.f90 | 79 ++++++++++++++++++++++--------------- test/Fileread/getp.f90 | 22 ++++++----- test/Fileread/mat_dist.f90 | 12 ++---- test/Fileread/partgraph.f90 | 2 +- test/Fileread/read_mat.f90 | 5 +-- 8 files changed, 74 insertions(+), 57 deletions(-) diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 09309c35..44d274b6 100644 --- a/src/methd/psb_dcgstab.f90 +++ b/src/methd/psb_dcgstab.f90 @@ -375,7 +375,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& 9999 continue call psb_erractionrestore(err_act) if (err_act.eq.act_abort) then - call psb_error() + call psb_error(icontxt) return end if return diff --git a/src/psblas/psb_dnrm2.f90 b/src/psblas/psb_dnrm2.f90 index ae70ce7c..59124126 100644 --- a/src/psblas/psb_dnrm2.f90 +++ b/src/psblas/psb_dnrm2.f90 @@ -169,6 +169,7 @@ function psb_dnrm2v(x, desc_a, info) m = desc_a%matrix_data(psb_m_) + call psb_chkvect(m,1,size(x),ix,jx,desc_a%matrix_data,info,iix,jjx) if(info.ne.0) then info=4010 diff --git a/test/Fileread/RUNS/rtst.inp b/test/Fileread/RUNS/rtst.inp index fec426ab..41615778 100644 --- a/test/Fileread/RUNS/rtst.inp +++ b/test/Fileread/RUNS/rtst.inp @@ -4,10 +4,10 @@ NONE BICGSTAB ILU !!!! Actually, it's IPREC below. Should take this line out. CSR -0 IPART: Partition method -2 ISTOPC +2 IPART: Partition method +1 ISTOPC 00800 ITMAX -6 ITRACE -2 IPREC 0:NONE 1:DIAGSC 2:ILU 3: AS 4: RAS 5,6: variants +-1 ITRACE +7 IPREC 0:NONE 1:DIAGSC 2:ILU 3: AS 4: RAS 5,6: variants 1 ML 1.d-6 EPS diff --git a/test/Fileread/df_sample.f90 b/test/Fileread/df_sample.f90 index 3f720f6c..5f72534d 100644 --- a/test/Fileread/df_sample.f90 +++ b/test/Fileread/df_sample.f90 @@ -59,7 +59,7 @@ program df_sample ! solver paramters integer :: iter, itmax, ierr, itrace, ircode, ipart,& - & methd, istopc, ml, iprec, novr + & methd, istopc, ml, iprec, novr, igsmth, matop character(len=5) :: afmt character(len=20) :: name @@ -85,6 +85,8 @@ program df_sample name='df_sample' info=0 + call psb_set_errverbosity(2) + call psb_set_erraction(0) ! ! get parameters ! @@ -114,7 +116,8 @@ program df_sample write(0,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) else - write(0,'("Generating an rhs ")') + write(*,'("Generating an rhs...")') + write(*,'(" ")') allocate(aux_b(m_problem,1), stat=ircode) if (ircode /= 0) then call psb_errpush(4000,name) @@ -141,7 +144,7 @@ program df_sample ! switch over different partition types if (ipart.eq.0) then call blacs_barrier(ictxt,'a') - write(6,'("Partition type: block")') + if (amroot) write(*,'("Partition type: block")') allocate(ivg(m_problem),ipv(np)) do i=1,m_problem call part_block(i,m_problem,np,ipv,nv) @@ -151,7 +154,7 @@ program df_sample & desc_a,b_col_glob,b_col,info,fmt=afmt) else if (ipart.eq.1) then call blacs_barrier(ictxt,'a') - write(6,'("Partition type: blk2")') + if (amroot) write(*,'("Partition type: blk2")') allocate(ivg(m_problem),ipv(np)) do i=1,m_problem call part_blk2(i,m_problem,np,ipv,nv) @@ -160,9 +163,10 @@ program df_sample call matdist(aux_a, a, ivg, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt) else if (ipart.eq.2) then - write(6,'("Partition type: graph")') if (amroot) then - write(0,'("Build type: graph")') + write(*,'("Partition type: graph")') + write(*,'(" ")') +! write(0,'("Build type: graph")') call build_grppart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np) endif call blacs_barrier(ictxt,'a') @@ -171,7 +175,7 @@ program df_sample call matdist(aux_a, a, ivg, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt) else - write(6,'("Partition type: block")') + if (amroot) write(*,'("Partition type: block")') call matdist(aux_a, a, part_block, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt) end if @@ -189,7 +193,9 @@ program df_sample & t1, t1, -1, -1, -1) if (amroot) then - write(6,'("Time to read and partition matrix : ",es10.4)')t2 + write(*,'(" ")') + write(*,'("Time to read and partition matrix : ",es10.4)')t2 + write(*,'(" ")') end if ! @@ -197,9 +203,11 @@ program df_sample ! of optional parameters ! - if (amroot) write(6,'("Preconditioner : ",a)')prec(1:6) + if (amroot) write(*,'("Preconditioner : ",a)')prec(1:6) ! zero initial guess. + matop=1 + igsmth=-1 select case(iprec) case(noprec_) call psb_precset(pre,'noprec') @@ -215,23 +223,36 @@ program df_sample call psb_precset(pre,'asm',iv=(/novr,halo_,none_/)) case(rash_) call psb_precset(pre,'asm',iv=(/novr,nohalo_,none_/)) + case(ras2lv_) + call psb_precset(pre,'asm',iv=(/novr,halo_,none_/)) + call psb_precset(pre,'ml',& + &iv=(/add_ml_prec_,loc_aggr_,no_smth_,mat_repl_,& + & pre_smooth_,igsmth/),rs=0.d0) +!!$ call psb_precset(pre,'ml',& +!!$ &iv=(/add_ml_prec_,glb_aggr_,pre_smooth_,igsmth,matop/),rs=0.d0) + case(ras2lvm_) + call psb_precset(pre,'asm',iv=(/novr,halo_,none_/)) + call psb_precset(pre,'ml',& + & iv=(/mult_ml_prec_,glb_aggr_,pre_smooth_,igsmth,matop/),rs=0.d0) end select ! building the preconditioner t1 = mpi_wtime() call psb_precbld(a,pre,desc_a,info) tprec = mpi_wtime()-t1 + if (info /= 0) then + call psb_errpush(4010,name,a_err='psb_precbld') + goto 9999 + end if call dgamx2d(ictxt,'a',' ',ione, ione,tprec,ione,t1,t1,-1,-1,-1) - write(6,'("Preconditioner time: ",es10.4)')tprec - if (info /= 0) then - write(0,*) 'error in preconditioner :',info - call blacs_abort(ictxt,-1) - stop + if(amroot) then + write(*,'("Preconditioner time: ",es10.4)')tprec + write(*,'(" ")') end if - + iparm = 0 call blacs_barrier(ictxt,'all') t1 = mpi_wtime() @@ -250,31 +271,26 @@ program df_sample endif call blacs_barrier(ictxt,'all') t2 = mpi_wtime() - t1 - write(0,*)'Calling gamx2d' call dgamx2d(ictxt,'a',' ',ione, ione,t2,ione,t1,t1,-1,-1,-1) - write(0,*)'Calling axpby' call psb_axpby(1.d0,b_col,0.d0,r_col,desc_a,info) - write(0,*)'Calling spmm' call psb_spmm(-1.d0,a,x_col,1.d0,r_col,desc_a,info) - write(0,*)'Calling nrm2' call psb_nrm2(resmx,r_col,desc_a,info) - write(0,*)'Calling amax' call psb_amax(resmxp,r_col,desc_a,info) !!$ iter=iparm(5) !!$ err = rparm(2) if (amroot) then ! call psb_prec_descr(6,pre) - write(6,'("Matrix: ",a)')mtrx_file - write(6,'("Computed solution on ",i4," processors")')nprow - write(6,'("Iterations to convergence: ",i)')iter - write(6,'("Error indicator on exit: ",f7.2)')err - write(6,'("Time to buil prec. : ",es10.4)')tprec - write(6,'("Time to solve matrix : ",es10.4)')t2 - write(6,'("Time per iteration : ",es10.4)')t2/(iter) - write(6,'("Total time : ",es10.4)')t2+tprec - write(6,'("Residual norm 2 = ",f7.2)')resmx - write(6,'("Residual norm inf = ",f7.2)')resmxp + write(*,'("Matrix: ",a)')mtrx_file + write(*,'("Computed solution on ",i4," processors")')nprow + write(*,'("Iterations to convergence: ",i)')iter + write(*,'("Error indicator on exit: ",f7.2)')err + write(*,'("Time to buil prec. : ",es10.4)')tprec + write(*,'("Time to solve matrix : ",es10.4)')t2 + write(*,'("Time per iteration : ",es10.4)')t2/(iter) + write(*,'("Total time : ",es10.4)')t2+tprec + write(*,'("Residual norm 2 = ",es10.4)')resmx + write(*,'("Residual norm inf = ",es10.4)')resmxp end if allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr) @@ -284,7 +300,8 @@ program df_sample call psb_gather(x_col_glob,x_col,desc_a,info,iroot=0) call psb_gather(r_col_glob,r_col,desc_a,info,iroot=0) if (amroot) then - write(0,*) 'Saving x on file' + write(0,'(" ")') + write(0,'("Saving x on file")') write(20,*) 'matrix: ',mtrx_file write(20,*) 'computed solution on ',nprow,' processors.' write(20,*) 'iterations to convergence: ',iter diff --git a/test/Fileread/getp.f90 b/test/Fileread/getp.f90 index 4b67ed75..2e992021 100644 --- a/test/Fileread/getp.f90 +++ b/test/Fileread/getp.f90 @@ -8,10 +8,10 @@ CONTAINS ! Get iteration parameters from the command line ! SUBROUTINE GET_PARMS(ICONTXT,MTRX_FILE,RHS_FILE,CMETHD,PREC,IPART,& - & AFMT,ISTOPC,ITMAX,ITRACE,ML,IPREC,EPS) + & AFMT,ISTOPC,ITMAX,ITRACE,NOVR,IPREC,EPS) integer :: icontxt Character*20 :: CMETHD, PREC, MTRX_FILE, RHS_FILE - Integer :: IRET, ISTOPC,ITMAX,ITRACE,IPART,IPREC,ML + Integer :: IRET, ISTOPC,ITMAX,ITRACE,IPART,IPREC,NOVR Character*40 :: CHARBUF real(kind(1.d0)) :: eps character :: afmt*5 @@ -78,9 +78,9 @@ CONTAINS IPREC=0 ENDIF IF (IP.GE.10) THEN - READ(*,*) ML + READ(*,*) NOVR ELSE - ML = 1 + NOVR = 1 ENDIF IF (IP.GE.11) THEN READ(*,*) EPS @@ -94,13 +94,17 @@ CONTAINS INPARMS(3) = ITMAX INPARMS(4) = ITRACE INPARMS(5) = IPREC - INPARMS(6) = ML + INPARMS(6) = NOVR CALL IGEBS2D(ICONTXT,'ALL',' ',6,1,INPARMS,6) CALL DGEBS2D(ICONTXT,'ALL',' ',1,1,EPS,1) - WRITE(6,*)'Solving matrix: ',mtrx_file - WRITE(6,*)' with BLOCK data distribution, NP=',NPROW,& - & ' Preconditioner=',PREC + write(*,'("Solving matrix : ",a)')mtrx_file + write(*,'("Number of processors : ",i)')nprow + write(*,'("Data distribution : ",i2)')ipart + write(*,'("Preconditioner : ",i)')iprec + if(iprec.gt.2) write(*,'("Overlapping levels : ",i)')novr + write(*,'("Iterative method : ",a)')cmethd + write(*,'(" ")') else CALL PR_USAGE(0) CALL BLACS_ABORT(ICONTXT,-1) @@ -134,7 +138,7 @@ CONTAINS ITMAX = INPARMS(3) ITRACE = INPARMS(4) IPREC = INPARMS(5) - ML = INPARMS(6) + NOVR = INPARMS(6) CALL DGEBR2D(ICONTXT,'A',' ',1,1,EPS,1,0,0) END IF diff --git a/test/Fileread/mat_dist.f90 b/test/Fileread/mat_dist.f90 index 04055481..168cd210 100644 --- a/test/Fileread/mat_dist.f90 +++ b/test/Fileread/mat_dist.f90 @@ -603,11 +603,6 @@ contains goto 9999 endif - if (myprow == root) then - write (*, fmt = *) 'start matdist v',root, size(iwork),& - &nrow, ncol, nnzero,nrhs - endif - call psb_dscall(nrow,v,icontxt,desc_a,info) if(info/=0) then info=4010 @@ -785,9 +780,11 @@ contains goto 9999 end if + call psb_asb(b,desc_a,info) + if (myprow == root) then - write(*,*) 'descriptor assembly: ',t1-t0 - write(*,*) 'sparse matrix assembly: ',t3-t2 + write(*,'("Descriptor assembly : ",es10.4)')t1-t0 + write(*,'("Sparse matrix assembly: ",es10.4)')t3-t2 end if if(info/=0)then @@ -805,7 +802,6 @@ contains end if deallocate(iwork) - if (myprow == root) write (*, fmt = *) 'end matdist v' call psb_erractionrestore(err_act) return diff --git a/test/Fileread/partgraph.f90 b/test/Fileread/partgraph.f90 index 1b1ebeb2..8d44fe7c 100644 --- a/test/Fileread/partgraph.f90 +++ b/test/Fileread/partgraph.f90 @@ -139,7 +139,7 @@ CONTAINS wgflag = 0 call METIS_PartGraphRecursive(n,ia2,ia1,idummy,jdummy,& & wgflag,numflag,nparts,iopt,nedc,graph_vect) - write(0,*)'Edge cut from Metis ',nedc +! write(0,*)'Edge cut from Metis ',nedc DO I=1, N GRAPH_VECT(I) = GRAPH_VECT(I) - 1 ENDDO diff --git a/test/Fileread/read_mat.f90 b/test/Fileread/read_mat.f90 index a9895353..6219aaa2 100644 --- a/test/Fileread/read_mat.f90 +++ b/test/Fileread/read_mat.f90 @@ -60,9 +60,8 @@ contains end if call blacs_gridinfo(ictxt, nprow, npcol, myprow, mypcol) if (myprow == root) then - write(*, *) 'start read_matrix' ! open input file + write(*, '("Reading matrix...")') ! open input file call mm_mat_read(a,info,infile,filename) - write(*, *) 'end read_matrix' if (info /= 0) then write(0,*) 'Error return from MM_MAT_READ ',info call blacs_abort(ictxt, 1) ! Unexpected End of File @@ -93,7 +92,7 @@ contains end if call blacs_gridinfo(ictxt, nprow, npcol, myprow, mypcol) if (myprow == root) then - write(*, *) 'start read_rhs' ! open input file + write(*, '("Reading rhs...")') ! open input file open(infile,file=filename, status='old', err=901, action="read") read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym write(0,*)'obj fmt',object, fmt