fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixes for complex halo gather.

Browse Source
stopcriterion
Salvatore Filippone 18 years ago
parent 3173937349
commit bdf13ac3d1
6 changed files with 81 additions and 76 deletions
Show Stats Download Patch File Download Diff File

9
psb_dasmatbld.f90
Unescape Escape View File

@ -191,14 +191,8 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
n_row = desc_p%matrix_data(psb_n_row_)
t2 = psb_wtime()
!!$ open(60+me)
!!$ call psb_cdprt(60+me,desc_p,short=.false.)
!!$ close(60+me)
!!$ call psb_barrier(ictxt)
if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovrb, 0, "st OVR" )
!!$ blk%m = n_row-nrow_a
!!$ blk%k = n_row
if (present(outfmt)) then
if(debug) write(0,*) me,': Calling outfmt SPHALO with ',size(blk%ia2)
@ -217,7 +211,6 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
end if
if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovre, 0, "ed OVR" )
t3 = psb_wtime()
if (debugprt) then

16
psb_dbjac_bld.f90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
character :: trans, unitd
type(psb_dspmat_type) :: blck, atmp
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6, t7, t8
logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
logical, parameter :: debugprt=.true., debug=.false., aggr_dump=.false.
integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,&
& n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia
integer :: ictxt,np,me
@ -198,7 +198,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
case(f_umf_)
call psb_ipcoo2csc(atmp,info)
call psb_ipcoo2csc(atmp,info,clshr=.true.)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
goto 9999
@ -240,6 +240,16 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
case(f_ilu_n_,f_ilu_e_)
if (debugprt) then
call psb_barrier(ictxt)
open(40+me)
call psb_csprt(40+me,a,head='% Local matrix')
close(40+me)
open(60+me)
call psb_csprt(60+me,blck,head='% Halo matrix')
close(60+me)
endif
call psb_ipcoo2csr(blck,info,rwshr=.true.)
if(info/=0) then
@ -302,7 +312,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
call psb_rwextd(atmp%m+blck%m,atmp,info,blck,rowscale=.true.)
if (info == 0) call psb_ipcoo2csc(atmp,info)
if (info == 0) call psb_ipcoo2csc(atmp,info,clshr=.true.)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
goto 9999

4
psb_dilu_fct.f90
Unescape Escape View File

@ -179,7 +179,7 @@ contains
! use spgtblk, slower but able (in principle) to handle
! anything.
!
if (a%fida=='CSR') then
if (toupper(a%fida)=='CSR') then
do j = a%ia2(i), a%ia2(i+1) - 1
k = a%ia1(j)
! write(0,*)'KKKKK',k
@ -318,7 +318,7 @@ contains
d(i) = 0.d0
if (b%fida=='CSR') then
if (toupper(b%fida)=='CSR') then
do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1
k = b%ia1(j)

15
psb_zasmatbld.f90
Unescape Escape View File

@ -86,6 +86,8 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
If(debug) Write(0,*)'IN DASMATBLD ', upd
ictxt=desc_data%matrix_data(psb_ctxt_)
Call psb_info(ictxt, me, np)
tot_recv=0
nrow_a = desc_data%matrix_data(psb_n_row_)
@ -129,7 +131,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
!
!
ictxt=desc_data%matrix_data(psb_ctxt_)
if (novr < 0) then
info=3
@ -138,7 +139,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
goto 9999
endif
if (novr == 0) then
if ((novr == 0).or.(np==1)) then
!
! This is really just Block Jacobi.....
!
@ -169,7 +170,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
call psb_get_mpicomm(ictxt,icomm)
Call psb_info(ictxt, me, np)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = psb_wtime()
@ -186,7 +186,8 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
end if
Endif
if(debug) write(0,*) me,' From bldext:',desc_p%matrix_data(psb_n_row_),desc_p%matrix_data(psb_n_col_)
if(debug) write(0,*) me,' From cdbldext _:',desc_p%matrix_data(psb_n_row_),&
& desc_p%matrix_data(psb_n_col_)
n_row = desc_p%matrix_data(psb_n_row_)
@ -195,11 +196,11 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
if (present(outfmt)) then
if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2)
Call psb_sphalo(a,desc_p,blk,info,outfmt=outfmt)
if(debug) write(0,*) me,': Calling outfmt SPHALO with ',size(blk%ia2)
Call psb_sphalo(a,desc_p,blk,info,outfmt=outfmt,data=psb_comm_ext_)
else
if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2)
Call psb_sphalo(a,desc_p,blk,info)
Call psb_sphalo(a,desc_p,blk,info,data=psb_comm_ext_)
end if

105
psb_zbjac_bld.f90
Unescape Escape View File

@ -78,7 +78,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
if(psb_get_errstatus().ne.0) return
info=0
name='psb_bjac_bld'
name='psb_zbjac_bld'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
@ -113,9 +113,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
& blck,desc_a,upd,p%desc_data,info,outfmt=coofmt)
if(info/=0) then
info=4010
ch_err='psb_asmatbld'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(4010,name,a_err='psb_asmatbld')
goto 9999
end if
@ -124,7 +122,9 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
if (debug) call psb_barrier(ictxt)
if (p%iprcparm(iren_) > 0) then
select case(p%iprcparm(iren_))
case (1:)
!
! Here we allocate a full copy to hold local A and received BLK
@ -133,10 +133,8 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
call psb_sp_renum(a,desc_a,blck,p,atmp,info)
if(info/=0) then
info=4010
ch_err='psb_sp_renum'
call psb_errpush(info,name,a_err=ch_err)
if (info/=0) then
call psb_errpush(4010,name,a_err='psb_sp_renum')
goto 9999
end if
@ -155,20 +153,20 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
case(f_ilu_n_,f_ilu_e_)
call psb_ipcoo2csr(atmp,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_ipcoo2csr')
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
call psb_ilu_bld(atmp,p%desc_data,p,upd,info)
if(info/=0) then
info=4010
call psb_errpush(info,name,a_err='psb_ilu_bld')
if (info/=0) then
call psb_errpush(4010,name,a_err='psb_ilu_bld')
goto 9999
end if
if (debugprt) then
open(80+me)
@ -188,15 +186,13 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
call psb_ipcoo2csr(atmp,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_ipcoo2csr')
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
call psb_slu_bld(atmp,p%desc_data,p,info)
if(info /= 0) then
info=4010
call psb_errpush(info,name,a_err='slu_bld')
call psb_errpush(4010,name,a_err='slu_bld')
goto 9999
end if
@ -204,16 +200,14 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
call psb_ipcoo2csc(atmp,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_ipcoo2csc')
call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
goto 9999
end if
call psb_umf_bld(atmp,p%desc_data,p,info)
if(debug) write(0,*)me,': Done umf_bld ',info
if (info /= 0) then
info = 4010
call psb_errpush(info,name,a_err='umf_bld')
call psb_errpush(4010,name,a_err='umf_bld')
goto 9999
end if
@ -231,14 +225,15 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
call psb_sp_free(atmp,info)
if(info/=0) then
info=4010
call psb_errpush(info,name,a_err='psb_sp_free')
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
end if
else if (p%iprcparm(iren_) == 0) then
case(0) ! No renumbering
select case(p%iprcparm(f_type_))
@ -247,14 +242,19 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
call psb_ipcoo2csr(blck,info,rwshr=.true.)
if (info==0) call psb_ilu_bld(a,desc_a,p,upd,info,blck=blck)
if(info/=0) then
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
call psb_ilu_bld(a,desc_a,p,upd,info,blck=blck)
if(info/=0) then
info=4010
call psb_errpush(info,name,a_err='psb_ilu_bld')
call psb_errpush(4010,name,a_err='psb_ilu_bld')
goto 9999
end if
if (debugprt) then
open(80+me)
@ -270,63 +270,65 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
endif
case(f_slu_)
atmp%fida='COO'
call psb_csdp(a,atmp,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_csdp')
call psb_errpush(4010,name,a_err='psb_csdp')
goto 9999
end if
call psb_rwextd(atmp%m+blck%m,atmp,info,blck,rowscale=.true.)
call psb_ipcoo2csr(atmp,info)
call psb_slu_bld(atmp,p%desc_data,p,info)
if (info == 0) call psb_ipcoo2csr(atmp,info)
if (info == 0) call psb_slu_bld(atmp,p%desc_data,p,info)
if(info /= 0) then
info=4010
call psb_errpush(info,name,a_err='slu_bld')
call psb_errpush(4010,name,a_err='slu_bld')
goto 9999
end if
call psb_sp_free(atmp,info)
if(info/=0) then
info=4010
call psb_errpush(info,name,a_err='psb_sp_free')
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
end if
case(f_umf_)
atmp%fida='COO'
atmp%fida='COO'
call psb_csdp(a,atmp,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_csdp')
call psb_errpush(4010,name,a_err='psb_csdp')
goto 9999
end if
if (debugprt) then
call psb_barrier(ictxt)
open(40+me)
call psb_csprt(40+me,atmp,head='% Local matrix')
close(40+me)
open(60+me)
call psb_csprt(60+me,blck,head='% Halo matrix')
close(60+me)
endif
call psb_rwextd(atmp%m+blck%m,atmp,info,blck,rowscale=.true.)
if (info == 0) call psb_ipcoo2csc(atmp,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_ipcoo2csc')
call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
goto 9999
end if
call psb_umf_bld(atmp,p%desc_data,p,info)
if(debug) write(0,*)me,': Done umf_bld ',info
if (info /= 0) then
info = 4010
call psb_errpush(info,name,a_err='umf_bld')
call psb_errpush(4010,name,a_err='umf_bld')
goto 9999
end if
call psb_sp_free(atmp,info)
if(info/=0) then
info=4010
call psb_errpush(info,name,a_err='psb_sp_free')
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
end if
@ -342,22 +344,25 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
goto 9999
end select
case default
info=4010
call psb_errpush(info,name,a_err='Invalid renum_')
goto 9999
endif
end select
t6 = psb_wtime()
call psb_sp_free(blck,info)
if(info/=0) then
info=4010
ch_err='psb_sp_free'
call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
end if
if (debug) write(0,*) me,'End of ilu_bld'
call psb_erractionrestore(err_act)
return
9999 continue

8
psb_zilu_fct.f90
Unescape Escape View File

@ -175,7 +175,7 @@ contains
! use spgtblk, slower but able (in principle) to handle
! anything.
!
if (a%fida=='CSR') then
if (toupper(a%fida)=='CSR') then
do j = a%ia2(i), a%ia2(i+1) - 1
k = a%ia1(j)
! write(0,*)'KKKKK',k
@ -314,22 +314,19 @@ contains
d(i) = zzero
if (b%fida=='CSR') then
if (toupper(b%fida)=='CSR') then
do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1
k = b%ia1(j)
! if (me.eq.2) write(0,*)'ecco k=',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = b%aspk(j)
lia1(l1) = k
! if(me.eq.2) write(0,*)'scrivo l'
else if (k == i) then
d(i) = b%aspk(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = b%aspk(j)
! write(0,*)'KKKKK',k
uia1(l2) = k
end if
enddo
@ -352,7 +349,6 @@ contains
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
! write(0,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%aspk(ktrw)

Write Preview
Loading…
Cancel
Save