*** empty log message ***

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

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
 

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,6 +220,9 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
     Else If (listop == 2) Then 
       rni = psb_nrm2(r,desc_a,info)
     Endif
+    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)
@@ -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

src/psblas/psb_daxpby.f90

@@ -200,13 +200,13 @@ subroutine  psb_daxpbyv(alpha, x, beta,y,desc_a,info)
      call psb_errpush(info,name)
   end if
   
-  if ((in.ne.0)) then
+  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
-  end if
   
   call psb_erractionrestore(err_act)
   return  

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'

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