*** empty log message ***

psblas3-type-indexed
Alfredo Buttari 19 years ago
parent 9ba784bdca
commit 17ae68eacb

@ -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

@ -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

@ -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

@ -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

@ -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'

@ -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

Loading…
Cancel
Save