diff --git a/src/internals/psi_dswapdata.f90 b/src/internals/psi_dswapdata.f90 index 3680455a..aa538bd9 100644 --- a/src/internals/psi_dswapdata.f90 +++ b/src/internals/psi_dswapdata.f90 @@ -27,10 +27,6 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) character(len=20) :: name, ch_err interface psi_gth - subroutine psi_dgthmm(n,k,idx,x,y,myrow,icontxt) - integer :: n, k, idx(:),myrow,icontxt - real(kind(1.d0)) :: x(:,:), y(:) - end subroutine psi_dgthmm subroutine psi_dgthm(n,k,idx,x,y) integer :: n, k, idx(:) real(kind(1.d0)) :: x(:,:), y(:) @@ -304,7 +300,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) end do do i=1, totxch + write(0,'(i2," waiting")')myrow call mpi_waitany(nprow,rvhd,ixrec,p2pstat,iret) + write(0,'(i2," done")')myrow if(iret.ne.mpi_success) then int_err(1) = iret info=400 diff --git a/src/internals/psi_gthsct.f90 b/src/internals/psi_gthsct.f90 index ffde4eed..3c6225b5 100644 --- a/src/internals/psi_gthsct.f90 +++ b/src/internals/psi_gthsct.f90 @@ -1,23 +1,3 @@ -subroutine psi_dgthmm(n,k,idx,x,y,myrow,icontxt) - - implicit none - - integer :: n, k, idx(:),myrow,icontxt - real(kind(1.d0)) :: x(:,:), y(:) - - ! Locals - integer :: i, j, pt - - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(pt)=x(idx(i),j) - end do - end do - -end subroutine psi_dgthmm - subroutine psi_dgthm(n,k,idx,x,y) implicit none @@ -28,7 +8,6 @@ subroutine psi_dgthm(n,k,idx,x,y) ! Locals integer :: i, j, pt - write(0,'("Inside gth ",5(i6,2x))')n,k,size(idx),size(x),size(y) pt=0 do j=1,k do i=1,n @@ -36,7 +15,6 @@ subroutine psi_dgthm(n,k,idx,x,y) y(pt)=x(idx(i),j) end do end do - write(0,'("Leaving gth")') end subroutine psi_dgthm diff --git a/src/methd/psb_dcgstab.f90 b/src/methd/psb_dcgstab.f90 index 20770c63..fd2d5f3e 100644 --- a/src/methd/psb_dcgstab.f90 +++ b/src/methd/psb_dcgstab.f90 @@ -175,6 +175,9 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& Else If (listop == 2) Then bn2 = psb_nrm2(b,desc_a,info) Endif + call blacs_barrier(icontxt,'All') ! to be removed + write(0,'(i2," ani bni bn2 ",3(f10.2,2x))')myrow,ani,bni,bn2 + call blacs_barrier(icontxt,'All') ! to be removed if (info /= 0) Then info=4011 call psb_errpush(info,name) @@ -187,9 +190,17 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& !!$ If (itx >= itmax) Exit restart it = 0 + write(0,'(i2," b ",10(f10.2,2x))')myrow,b(1:10) + write(0,'(i2," r ",10(f10.2,2x))')myrow,r(1:10) Call psb_axpby(one,b,zero,r,desc_a,info) + write(0,'(i2," b ",10(f10.2,2x))')myrow,b(1:10) + write(0,'(i2," r ",10(f10.2,2x))')myrow,r(1:10) Call psb_spmm(-one,a,x,one,r,desc_a,info,work=aux) + write(0,'(i2," x ",10(f10.2,2x))')myrow,x(1:10) + write(0,'(i2," r ",10(f10.2,2x))')myrow,r(1:10) Call psb_axpby(one,r,zero,q,desc_a,info) + write(0,'(i2," q ",10(f10.2,2x))')myrow,q(1:10) + write(0,'(i2," r ",10(f10.2,2x))')myrow,r(1:10) if (info /= 0) Then info=4011 call psb_errpush(info,name) @@ -209,11 +220,14 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& Else If (listop == 2) Then rni = psb_nrm2(r,desc_a,info) Endif - if (info /= 0) Then - info=4011 - call psb_errpush(info,name) - goto 9999 - End If + call blacs_barrier(icontxt,'All') ! to be removed + write(0,'(i2," rni xni ",2(f10.2,2x))')myrow,rni,xni + call blacs_barrier(icontxt,'All') ! to be removed + if (info /= 0) Then + info=4011 + call psb_errpush(info,name) + goto 9999 + End If If (itx == 0) Then rn0 = rni @@ -244,6 +258,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& goto 9999 End If + If (rerr<=eps) Then Exit restart End If @@ -254,6 +269,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,& If (debug) Write(*,*) 'Iteration: ',itx rho_old = rho rho = psb_dot(q,r,desc_a,info) + write(0,'(i2," rho old ",2(f10.2,2x))')myrow,rho,rho_old If (rho==zero) Then If (debug) Write(0,*) 'Bi-CGSTAB Itxation breakdown R',rho Exit iteration diff --git a/src/psblas/psb_daxpby.f90 b/src/psblas/psb_daxpby.f90 index 84df9950..61a64236 100644 --- a/src/psblas/psb_daxpby.f90 +++ b/src/psblas/psb_daxpby.f90 @@ -200,14 +200,14 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) call psb_errpush(info,name) end if - if ((in.ne.0)) then - if(desc_a%matrix_data(psb_n_row_).gt.0) then - call daxpby(desc_a%matrix_data(psb_n_col_),ione,& - & alpha,x,size(x),beta,& - & y,size(y),info) - end if + write(0,'(i2," before daxpby",2(i6,2x),2(f10.2,2x))')myrow,desc_a%matrix_data(psb_n_row_),& + & desc_a%matrix_data(psb_n_col_),alpha,beta + if(desc_a%matrix_data(psb_n_row_).gt.0) then + call daxpby(desc_a%matrix_data(psb_n_col_),ione,& + & alpha,x,size(x),beta,& + & y,size(y),info) end if - + call psb_erractionrestore(err_act) return diff --git a/src/psblas/psb_ddot.f90 b/src/psblas/psb_ddot.f90 index fe516505..08ea20f0 100644 --- a/src/psblas/psb_ddot.f90 +++ b/src/psblas/psb_ddot.f90 @@ -160,7 +160,7 @@ function psb_ddotv(x, y,desc_a, info) ! locals integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& - & err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k + & err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k real(kind(1.d0)),pointer :: tmpx(:) real(kind(1.D0)) :: dot_local real(kind(1.d0)) :: ddot @@ -187,11 +187,13 @@ function psb_ddotv(x, y,desc_a, info) ix = ione iy = ione + jx = ione + jy = ione m = desc_a%matrix_data(psb_m_) ! check vector correctness - call psb_chkvect(m,ione,size(x,1),ix,ijx,desc_a%matrix_data,info,iix,jjx) - call psb_chkvect(m,ione,size(y,1),iy,ijy,desc_a%matrix_data,info,iiy,jjy) + call psb_chkvect(m,ione,size(x,1),ix,jx,desc_a%matrix_data,info,iix,jjx) + call psb_chkvect(m,ione,size(y,1),iy,jy,desc_a%matrix_data,info,iiy,jjy) if(info.ne.0) then info=4010 ch_err='psb_chkvect' diff --git a/test/pargen/RUNS/ppde.inp b/test/pargen/RUNS/ppde.inp index ee82cf4f..cdf46cd4 100644 --- a/test/pargen/RUNS/ppde.inp +++ b/test/pargen/RUNS/ppde.inp @@ -4,7 +4,7 @@ NONE Preconditioner ILU DIAGSC NONE CSR A Storage format CSR COO JAD 20 Domain size (acutal sistem is this**3) 1 Stopping criterion -080 MAXIT +2 MAXIT 00 ITRACE 02 ML