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

mld2p4-2:

Browse Source 
mlprec/impl/mld_caggrmat_smth_asb.f90
 mlprec/impl/mld_daggrmat_smth_asb.f90
 mlprec/impl/mld_saggrmat_smth_asb.f90
 mlprec/impl/mld_zaggrmat_smth_asb.f90


Mods to aggrmat to use spspmm.
stopcriterion
Salvatore Filippone 11 years ago
parent 73b5b8635e
commit e3855c9ca5
4 changed files with 52 additions and 88 deletions
Show Stats Download Patch File Download Diff File

35
mlprec/impl/mld_caggrmat_smth_asb.f90
Unescape Escape View File

@ -286,25 +286,22 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
! !
! acsrm1 = (I-w*D*Af)Ptilde ! acsrm1 = (I-w*D*Af)Ptilde
! Doing it this way means to consider diag(Af_i) ! Doing it this way means to consider diag(Af_i)
! !
! !
call psb_symbmm(acsrf,ptilde,acsr1,info) call psb_spspmm(acsrf,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsrf,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
else else
@ -323,25 +320,21 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
!
! acsrm1 = (I-w*D*A)Ptilde ! acsrm1 = (I-w*D*A)Ptilde
! Doing it this way means to consider diag(A_i) ! Doing it this way means to consider diag(A_i)
! !
! !
call psb_symbmm(acsr3,ptilde,acsr1,info) call psb_spspmm(acsr3,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsr3,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
end if end if
call ptilde%free() call ptilde%free()
@ -361,16 +354,15 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_symbmm(a,op_prol,am3,info) call psb_spspmm(a,op_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
end if end if
call psb_numbmm(a,op_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
@ -414,9 +406,8 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'starting symbmm 3' & 'starting spspmm 3'
call psb_symbmm(op_restr,am3,ac,info) call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call psb_numbmm(op_restr,am3,ac)
if (info == psb_success_) call am3%free() if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_) if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then

35
mlprec/impl/mld_daggrmat_smth_asb.f90
Unescape Escape View File

@ -286,25 +286,22 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
! !
! acsrm1 = (I-w*D*Af)Ptilde ! acsrm1 = (I-w*D*Af)Ptilde
! Doing it this way means to consider diag(Af_i) ! Doing it this way means to consider diag(Af_i)
! !
! !
call psb_symbmm(acsrf,ptilde,acsr1,info) call psb_spspmm(acsrf,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsrf,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
else else
@ -323,25 +320,21 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
!
! acsrm1 = (I-w*D*A)Ptilde ! acsrm1 = (I-w*D*A)Ptilde
! Doing it this way means to consider diag(A_i) ! Doing it this way means to consider diag(A_i)
! !
! !
call psb_symbmm(acsr3,ptilde,acsr1,info) call psb_spspmm(acsr3,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsr3,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
end if end if
call ptilde%free() call ptilde%free()
@ -361,16 +354,15 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_symbmm(a,op_prol,am3,info) call psb_spspmm(a,op_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
end if end if
call psb_numbmm(a,op_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
@ -414,9 +406,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'starting symbmm 3' & 'starting spspmm 3'
call psb_symbmm(op_restr,am3,ac,info) call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call psb_numbmm(op_restr,am3,ac)
if (info == psb_success_) call am3%free() if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_) if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then

35
mlprec/impl/mld_saggrmat_smth_asb.f90
Unescape Escape View File

@ -286,25 +286,22 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
! !
! acsrm1 = (I-w*D*Af)Ptilde ! acsrm1 = (I-w*D*Af)Ptilde
! Doing it this way means to consider diag(Af_i) ! Doing it this way means to consider diag(Af_i)
! !
! !
call psb_symbmm(acsrf,ptilde,acsr1,info) call psb_spspmm(acsrf,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsrf,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
else else
@ -323,25 +320,21 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
!
! acsrm1 = (I-w*D*A)Ptilde ! acsrm1 = (I-w*D*A)Ptilde
! Doing it this way means to consider diag(A_i) ! Doing it this way means to consider diag(A_i)
! !
! !
call psb_symbmm(acsr3,ptilde,acsr1,info) call psb_spspmm(acsr3,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsr3,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
end if end if
call ptilde%free() call ptilde%free()
@ -361,16 +354,15 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_symbmm(a,op_prol,am3,info) call psb_spspmm(a,op_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
end if end if
call psb_numbmm(a,op_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
@ -414,9 +406,8 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'starting symbmm 3' & 'starting spspmm 3'
call psb_symbmm(op_restr,am3,ac,info) call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call psb_numbmm(op_restr,am3,ac)
if (info == psb_success_) call am3%free() if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_) if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then

35
mlprec/impl/mld_zaggrmat_smth_asb.f90
Unescape Escape View File

@ -286,25 +286,22 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
! !
! acsrm1 = (I-w*D*Af)Ptilde ! acsrm1 = (I-w*D*Af)Ptilde
! Doing it this way means to consider diag(Af_i) ! Doing it this way means to consider diag(Af_i)
! !
! !
call psb_symbmm(acsrf,ptilde,acsr1,info) call psb_spspmm(acsrf,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsrf,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
else else
@ -323,25 +320,21 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done gather, going for SYMBMM 1' & 'Done gather, going for SPSPMM 1'
! !
! Symbmm90 does the allocation for its result.
!
! acsrm1 = (I-w*D*A)Ptilde ! acsrm1 = (I-w*D*A)Ptilde
! Doing it this way means to consider diag(A_i) ! Doing it this way means to consider diag(A_i)
! !
! !
call psb_symbmm(acsr3,ptilde,acsr1,info) call psb_spspmm(acsr3,ptilde,acsr1,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 1') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 1')
goto 9999 goto 9999
end if end if
call psb_numbmm(acsr3,ptilde,acsr1)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 1' & 'Done SPSPMM 1'
end if end if
call ptilde%free() call ptilde%free()
@ -361,16 +354,15 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
goto 9999 goto 9999
end if end if
call psb_symbmm(a,op_prol,am3,info) call psb_spspmm(a,op_prol,am3,info)
if(info /= psb_success_) then if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='symbmm 2') call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2')
goto 9999 goto 9999
end if end if
call psb_numbmm(a,op_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_
call op_prol%cp_to(tmpcoo) call op_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
@ -414,9 +406,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'starting symbmm 3' & 'starting spspmm 3'
call psb_symbmm(op_restr,am3,ac,info) call psb_spspmm(op_restr,am3,ac,info)
if (info == psb_success_) call psb_numbmm(op_restr,am3,ac)
if (info == psb_success_) call am3%free() if (info == psb_success_) call am3%free()
if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_) if (info == psb_success_) call ac%cscnv(info,type='coo',dupl=psb_dupl_add_)
if (info /= psb_success_) then if (info /= psb_success_) then

Write Preview
Loading…
Cancel
Save