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