Changed smooth_aggregate to call cdall with NL= argument.

stopcriterion
Salvatore Filippone 18 years ago
parent 0201bd53dd
commit af2df5ef8d

@ -269,33 +269,6 @@ contains
goto 9999 goto 9999
end if end if
if (.false.) then
!if(.not.associated(p%av(ap_nd_)%aspk)) p%iprcparm(jac_sweeps_) = 1
!------------------------------------------------------------------
! Split AC=M+N N off-diagonal part
! Output in COO format.
call psb_sp_clip(ac,p%av(ap_nd_),info,&
& jmin=ac%m+1,rscale=.false.,cscale=.false.)
call psb_ipcoo2csr(p%av(ap_nd_),info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
k = psb_sp_get_nnzeros(p%av(ap_nd_))
call psb_sum(ictxt,k)
if (k == 0) then
! If the off diagonal part is emtpy, there's no point
! in doing multiple Jacobi sweeps. This is certain
! to happen when running on a single processor.
p%iprcparm(jac_sweeps_) = 1
end if
!write(0,*) 'operations in bldaggrmat are ok !'
!------------------------------------------------------------------
end if
else else
write(0,*) 'Unknown p%iprcparm(coarse_mat) in aggregate_sp',p%iprcparm(coarse_mat_) write(0,*) 'Unknown p%iprcparm(coarse_mat) in aggregate_sp',p%iprcparm(coarse_mat_)
@ -338,7 +311,7 @@ contains
integer, intent(out) :: info integer, intent(out) :: info
type(psb_dspmat_type) :: b type(psb_dspmat_type) :: b
integer, pointer :: nzbr(:), idisp(:), ivall(:) integer, pointer :: nzbr(:), idisp(:)
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& integer :: ictxt, nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, np, me, & & naggr, np, me, &
& icomm, naggrm1,naggrp1,i,j,err_act,k,nzl & icomm, naggrm1,naggrp1,i,j,err_act,k,nzl
@ -738,22 +711,8 @@ contains
if(info /= 0) goto 9999 if(info /= 0) goto 9999
nzac = ac%infoa(psb_nnz_) nzac = ac%infoa(psb_nnz_)
nzl = ac%infoa(psb_nnz_) nzl = ac%infoa(psb_nnz_)
allocate(ivall(ntaggr),stat=info) call psb_cdall(ictxt,desc_ac,info,nl=p%nlaggr(me+1))
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
i = 1
do ip=1,np
do k=1, p%nlaggr(ip)
ivall(i) = ip
i = i + 1
end do
end do
call psb_cdall(ictxt,desc_ac,info,vg=ivall(1:ntaggr),flag=1)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_cdall') call psb_errpush(4010,name,a_err='psb_cdall')
goto 9999 goto 9999
@ -796,36 +755,12 @@ contains
ac%descra='G' ac%descra='G'
call psb_sp_free(b,info) call psb_sp_free(b,info)
if (info == 0) deallocate(nzbr,idisp,stat=info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free') call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999 goto 9999
end if end if
deallocate(ivall,nzbr,idisp)
if (.false.) then
! Split AC=M+N N off-diagonal part
! Output in COO format.
call psb_sp_clip(ac,p%av(ap_nd_),info,&
& jmin=ac%m+1,rscale=.false.,cscale=.false.)
call psb_ipcoo2csr(p%av(ap_nd_),info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
k = psb_sp_get_nnzeros(p%av(ap_nd_))
call psb_sum(ictxt,k)
if (k == 0) then
! If the off diagonal part is emtpy, there's no point
! in doing multiple Jacobi sweeps. This is certain
! to happen when running on a single processor.
p%iprcparm(jac_sweeps_) = 1
end if
end if
if (np>1) then if (np>1) then
nzl = psb_sp_get_nnzeros(am1) nzl = psb_sp_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I') call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')

@ -268,33 +268,6 @@ contains
goto 9999 goto 9999
end if end if
if (.false.) then
!if(.not.associated(p%av(ap_nd_)%aspk)) p%iprcparm(jac_sweeps_) = 1
!------------------------------------------------------------------
! Split AC=M+N N off-diagonal part
! Output in COO format.
call psb_sp_clip(ac,p%av(ap_nd_),info,&
& jmin=ac%m+1,rscale=.false.,cscale=.false.)
call psb_ipcoo2csr(p%av(ap_nd_),info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
k = psb_sp_get_nnzeros(p%av(ap_nd_))
call psb_sum(ictxt,k)
if (k == 0) then
! If the off diagonal part is emtpy, there's no point
! in doing multiple Jacobi sweeps. This is certain
! to happen when running on a single processor.
p%iprcparm(jac_sweeps_) = 1
end if
!write(0,*) 'operations in bldaggrmat are ok !'
!------------------------------------------------------------------
end if
else else
write(0,*) 'Unknown p%iprcparm(coarse_mat) in aggregate_sp',p%iprcparm(coarse_mat_) write(0,*) 'Unknown p%iprcparm(coarse_mat) in aggregate_sp',p%iprcparm(coarse_mat_)
@ -337,7 +310,7 @@ contains
integer, intent(out) :: info integer, intent(out) :: info
type(psb_zspmat_type) :: b type(psb_zspmat_type) :: b
integer, pointer :: nzbr(:), idisp(:), ivall(:) integer, pointer :: nzbr(:), idisp(:)
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& integer :: ictxt, nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
& naggr, np, me, & & naggr, np, me, &
& icomm, naggrm1,naggrp1,i,j,err_act,k,nzl & icomm, naggrm1,naggrp1,i,j,err_act,k,nzl
@ -737,22 +710,8 @@ contains
if(info /= 0) goto 9999 if(info /= 0) goto 9999
nzac = ac%infoa(psb_nnz_) nzac = ac%infoa(psb_nnz_)
nzl = ac%infoa(psb_nnz_) nzl = ac%infoa(psb_nnz_)
allocate(ivall(ntaggr),stat=info) call psb_cdall(ictxt,desc_ac,info,nl=p%nlaggr(me+1))
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999
end if
i = 1
do ip=1,np
do k=1, p%nlaggr(ip)
ivall(i) = ip
i = i + 1
end do
end do
call psb_cdall(ictxt,desc_ac,info,vg=ivall(1:ntaggr),flag=1)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_cdall') call psb_errpush(4010,name,a_err='psb_cdall')
goto 9999 goto 9999
@ -795,37 +754,12 @@ contains
ac%descra='G' ac%descra='G'
call psb_sp_free(b,info) call psb_sp_free(b,info)
if (info == 0) deallocate(nzbr,idisp,stat=info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free') call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999 goto 9999
end if end if
deallocate(ivall,nzbr,idisp)
if (.false.) then
! Split AC=M+N N off-diagonal part
! Output in COO format.
call psb_sp_clip(ac,p%av(ap_nd_),info,&
& jmin=ac%m+1,rscale=.false.,cscale=.false.)
call psb_ipcoo2csr(p%av(ap_nd_),info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
k = psb_sp_get_nnzeros(p%av(ap_nd_))
call psb_sum(ictxt,k)
if (k == 0) then
! If the off diagonal part is emtpy, there's no point
! in doing multiple Jacobi sweeps. This is certain
! to happen when running on a single processor.
p%iprcparm(jac_sweeps_) = 1
end if
end if
if (np>1) then if (np>1) then
nzl = psb_sp_get_nnzeros(am1) nzl = psb_sp_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I') call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')

Loading…
Cancel
Save