*** 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 character(len=20) :: name, ch_err
interface psi_gth 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) subroutine psi_dgthm(n,k,idx,x,y)
integer :: n, k, idx(:) integer :: n, k, idx(:)
real(kind(1.d0)) :: x(:,:), y(:) real(kind(1.d0)) :: x(:,:), y(:)
@ -304,7 +300,9 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info)
end do end do
do i=1, totxch do i=1, totxch
write(0,'(i2," waiting")')myrow
call mpi_waitany(nprow,rvhd,ixrec,p2pstat,iret) call mpi_waitany(nprow,rvhd,ixrec,p2pstat,iret)
write(0,'(i2," done")')myrow
if(iret.ne.mpi_success) then if(iret.ne.mpi_success) then
int_err(1) = iret int_err(1) = iret
info=400 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) subroutine psi_dgthm(n,k,idx,x,y)
implicit none implicit none
@ -28,7 +8,6 @@ subroutine psi_dgthm(n,k,idx,x,y)
! Locals ! Locals
integer :: i, j, pt integer :: i, j, pt
write(0,'("Inside gth ",5(i6,2x))')n,k,size(idx),size(x),size(y)
pt=0 pt=0
do j=1,k do j=1,k
do i=1,n do i=1,n
@ -36,7 +15,6 @@ subroutine psi_dgthm(n,k,idx,x,y)
y(pt)=x(idx(i),j) y(pt)=x(idx(i),j)
end do end do
end do end do
write(0,'("Leaving gth")')
end subroutine psi_dgthm end subroutine psi_dgthm

@ -175,6 +175,9 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Else If (listop == 2) Then Else If (listop == 2) Then
bn2 = psb_nrm2(b,desc_a,info) bn2 = psb_nrm2(b,desc_a,info)
Endif 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 if (info /= 0) Then
info=4011 info=4011
call psb_errpush(info,name) 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 If (itx >= itmax) Exit restart
it = 0 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) 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) 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) 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 if (info /= 0) Then
info=4011 info=4011
call psb_errpush(info,name) 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 Else If (listop == 2) Then
rni = psb_nrm2(r,desc_a,info) rni = psb_nrm2(r,desc_a,info)
Endif Endif
if (info /= 0) Then call blacs_barrier(icontxt,'All') ! to be removed
info=4011 write(0,'(i2," rni xni ",2(f10.2,2x))')myrow,rni,xni
call psb_errpush(info,name) call blacs_barrier(icontxt,'All') ! to be removed
goto 9999 if (info /= 0) Then
End If info=4011
call psb_errpush(info,name)
goto 9999
End If
If (itx == 0) Then If (itx == 0) Then
rn0 = rni rn0 = rni
@ -244,6 +258,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
goto 9999 goto 9999
End If End If
If (rerr<=eps) Then If (rerr<=eps) Then
Exit restart Exit restart
End If End If
@ -254,6 +269,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
If (debug) Write(*,*) 'Iteration: ',itx If (debug) Write(*,*) 'Iteration: ',itx
rho_old = rho rho_old = rho
rho = psb_dot(q,r,desc_a,info) 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 (rho==zero) Then
If (debug) Write(0,*) 'Bi-CGSTAB Itxation breakdown R',rho If (debug) Write(0,*) 'Bi-CGSTAB Itxation breakdown R',rho
Exit iteration Exit iteration

@ -200,14 +200,14 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
end if 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_),&
if(desc_a%matrix_data(psb_n_row_).gt.0) then & desc_a%matrix_data(psb_n_col_),alpha,beta
call daxpby(desc_a%matrix_data(psb_n_col_),ione,& if(desc_a%matrix_data(psb_n_row_).gt.0) then
& alpha,x,size(x),beta,& call daxpby(desc_a%matrix_data(psb_n_col_),ione,&
& y,size(y),info) & alpha,x,size(x),beta,&
end if & y,size(y),info)
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -160,7 +160,7 @@ function psb_ddotv(x, y,desc_a, info)
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& 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)),pointer :: tmpx(:)
real(kind(1.D0)) :: dot_local real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot real(kind(1.d0)) :: ddot
@ -187,11 +187,13 @@ function psb_ddotv(x, y,desc_a, info)
ix = ione ix = ione
iy = ione iy = ione
jx = ione
jy = ione
m = desc_a%matrix_data(psb_m_) m = desc_a%matrix_data(psb_m_)
! check vector correctness ! 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(x,1),ix,jx,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(y,1),iy,jy,desc_a%matrix_data,info,iiy,jjy)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_chkvect' ch_err='psb_chkvect'

@ -4,7 +4,7 @@ NONE Preconditioner ILU DIAGSC NONE
CSR A Storage format CSR COO JAD CSR A Storage format CSR COO JAD
20 Domain size (acutal sistem is this**3) 20 Domain size (acutal sistem is this**3)
1 Stopping criterion 1 Stopping criterion
080 MAXIT 2 MAXIT
00 ITRACE 00 ITRACE
02 ML 02 ML

Loading…
Cancel
Save