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

Fixed passing of TRANS down the call chain.

Browse Source
stopcriterion
Salvatore Filippone 17 years ago
parent 182664e76a
commit 95a3b66a94
2 changed files with 34 additions and 30 deletions
Show Stats Download Patch File Download Diff File

32
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -456,7 +456,7 @@ contains
! !
call mld_baseprec_aply(done,baseprecv(ilev),& call mld_baseprec_aply(done,baseprecv(ilev),&
& mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,&
& baseprecv(ilev)%desc_data, 'N',work,info) & baseprecv(ilev)%desc_data, trans,work,info)
enddo enddo
@ -636,8 +636,7 @@ contains
! Apply the base preconditioner at the finest level ! Apply the base preconditioner at the finest level
! !
call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,&
& dzero,mlprec_wrk(1)%y2l,& & dzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,&
& baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
if (info /=0) then if (info /=0) then
call psb_errpush(4010,name,a_err=' baseprec_aply') call psb_errpush(4010,name,a_err=' baseprec_aply')
@ -652,7 +651,8 @@ contains
mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l
call psb_spmm(-done,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,& call psb_spmm(-done,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,&
& done,mlprec_wrk(1)%tx,baseprecv(1)%base_desc,info,work=work) & done,mlprec_wrk(1)%tx,baseprecv(1)%base_desc,info,&
& work=work,trans=trans)
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err=' fine level residual') call psb_errpush(4001,name,a_err=' fine level residual')
goto 9999 goto 9999
@ -722,7 +722,7 @@ contains
! Apply the base preconditioner ! Apply the base preconditioner
! !
call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,& call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
& dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info) & dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data,trans,work,info)
! !
! Compute the residual (at all levels but the coarsest one) ! Compute the residual (at all levels but the coarsest one)
@ -731,7 +731,7 @@ contains
mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l
if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,& if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,&
& mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%tx,& & mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%tx,&
& baseprecv(ilev)%base_desc,info,work=work) & baseprecv(ilev)%base_desc,info,work=work,trans=trans)
endif endif
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err='Error on up sweep residual') call psb_errpush(4001,name,a_err='Error on up sweep residual')
@ -993,7 +993,7 @@ contains
! Apply the base preconditioner at the coarsest level ! Apply the base preconditioner at the coarsest level
! !
call mld_baseprec_aply(done,baseprecv(nlev),mlprec_wrk(nlev)%x2l, & call mld_baseprec_aply(done,baseprecv(nlev),mlprec_wrk(nlev)%x2l, &
& dzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info) & dzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,trans,work,info)
if (info /=0) then if (info /=0) then
call psb_errpush(4010,name,a_err='baseprec_aply') call psb_errpush(4010,name,a_err='baseprec_aply')
goto 9999 goto 9999
@ -1044,13 +1044,14 @@ contains
! Compute the residual ! Compute the residual
! !
call psb_spmm(-done,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& call psb_spmm(-done,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,&
& done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,work=work) & done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,&
& work=work,trans=trans)
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !
if (info == 0) call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%tx,& if (info == 0) call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%tx,&
& done,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info) & done,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc,trans,work,info)
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') call psb_errpush(4001,name,a_err=' spmm/baseprec_aply')
goto 9999 goto 9999
@ -1212,8 +1213,7 @@ contains
! Apply the base preconditioner at the finest level ! Apply the base preconditioner at the finest level
! !
call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,&
& dzero,mlprec_wrk(1)%y2l,& & dzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,&
& baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
! !
! STEP 3 ! STEP 3
@ -1222,7 +1222,8 @@ contains
! !
mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l
if (info == 0) call psb_spmm(-done,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,& if (info == 0) call psb_spmm(-done,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,&
& done,mlprec_wrk(1)%ty,baseprecv(1)%base_desc,info,work=work) & done,mlprec_wrk(1)%ty,baseprecv(1)%base_desc,info,&
& work=work,trans=trans)
if (info /=0) then if (info /=0) then
call psb_errpush(4010,name,a_err='Fine level baseprec/residual') call psb_errpush(4010,name,a_err='Fine level baseprec/residual')
goto 9999 goto 9999
@ -1296,7 +1297,7 @@ contains
! !
if (info == 0) call mld_baseprec_aply(done,baseprecv(ilev),& if (info == 0) call mld_baseprec_aply(done,baseprecv(ilev),&
& mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,&
& baseprecv(ilev)%desc_data, 'N',work,info) & baseprecv(ilev)%desc_data,trans,work,info)
! !
! Compute the residual (at all levels but the coarsest one) ! Compute the residual (at all levels but the coarsest one)
! !
@ -1304,7 +1305,7 @@ contains
mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l
if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,& if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,&
& mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%ty,& & mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%ty,&
& baseprecv(ilev)%base_desc,info,work=work) & baseprecv(ilev)%base_desc,info,work=work,trans=trans)
endif endif
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err='baseprec_aply/residual') call psb_errpush(4001,name,a_err='baseprec_aply/residual')
@ -1350,7 +1351,8 @@ contains
! Compute the residual ! Compute the residual
! !
call psb_spmm(-done,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& call psb_spmm(-done,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,&
& done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,work=work) & done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,&
& work=work,trans=trans)
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !

32
mlprec/mld_zmlprec_aply.f90
Unescape Escape View File

@ -457,7 +457,7 @@ contains
! !
call mld_baseprec_aply(zone,baseprecv(ilev),& call mld_baseprec_aply(zone,baseprecv(ilev),&
& mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,&
& baseprecv(ilev)%desc_data, 'N',work,info) & baseprecv(ilev)%desc_data,trans,work,info)
enddo enddo
@ -637,8 +637,7 @@ contains
! Apply the base preconditioner at the finest level ! Apply the base preconditioner at the finest level
! !
call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,&
& zzero,mlprec_wrk(1)%y2l,& & zzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,&
& baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
if (info /=0) then if (info /=0) then
call psb_errpush(4010,name,a_err=' baseprec_aply') call psb_errpush(4010,name,a_err=' baseprec_aply')
@ -653,7 +652,8 @@ contains
mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l
call psb_spmm(-zone,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,& call psb_spmm(-zone,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,&
& zone,mlprec_wrk(1)%tx,baseprecv(1)%base_desc,info,work=work) & zone,mlprec_wrk(1)%tx,baseprecv(1)%base_desc,info,&
& work=work,trans=trans)
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err=' fine level residual') call psb_errpush(4001,name,a_err=' fine level residual')
goto 9999 goto 9999
@ -723,7 +723,7 @@ contains
! Apply the base preconditioner ! Apply the base preconditioner
! !
call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%x2l,& call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
& zzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info) & zzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data,trans,work,info)
! !
! Compute the residual (at all levels but the coarsest one) ! Compute the residual (at all levels but the coarsest one)
@ -732,7 +732,7 @@ contains
mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l
if (info == 0) call psb_spmm(-zone,baseprecv(ilev)%base_a,& if (info == 0) call psb_spmm(-zone,baseprecv(ilev)%base_a,&
& mlprec_wrk(ilev)%y2l,zone,mlprec_wrk(ilev)%tx,& & mlprec_wrk(ilev)%y2l,zone,mlprec_wrk(ilev)%tx,&
& baseprecv(ilev)%base_desc,info,work=work) & baseprecv(ilev)%base_desc,info,work=work,trans=trans)
endif endif
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err='Error on up sweep residual') call psb_errpush(4001,name,a_err='Error on up sweep residual')
@ -993,7 +993,7 @@ contains
! Apply the base preconditioner at the coarsest level ! Apply the base preconditioner at the coarsest level
! !
call mld_baseprec_aply(zone,baseprecv(nlev),mlprec_wrk(nlev)%x2l, & call mld_baseprec_aply(zone,baseprecv(nlev),mlprec_wrk(nlev)%x2l, &
& zzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info) & zzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,trans,work,info)
if (info /=0) then if (info /=0) then
call psb_errpush(4010,name,a_err='baseprec_aply') call psb_errpush(4010,name,a_err='baseprec_aply')
goto 9999 goto 9999
@ -1044,13 +1044,14 @@ contains
! Compute the residual ! Compute the residual
! !
call psb_spmm(-zone,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& call psb_spmm(-zone,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,&
& zone,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,work=work) & zone,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,&
& work=work,trans=trans)
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !
if (info == 0) call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%tx,& if (info == 0) call mld_baseprec_aply(zone,baseprecv(ilev),mlprec_wrk(ilev)%tx,&
& zone,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc, trans, work,info) & zone,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%base_desc,trans,work,info)
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') call psb_errpush(4001,name,a_err=' spmm/baseprec_aply')
goto 9999 goto 9999
@ -1213,8 +1214,7 @@ contains
! Apply the base preconditioner at the finest level ! Apply the base preconditioner at the finest level
! !
call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,& call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,&
& zzero,mlprec_wrk(1)%y2l,& & zzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,&
& baseprecv(1)%base_desc,&
& trans,work,info) & trans,work,info)
! !
! STEP 3 ! STEP 3
@ -1223,7 +1223,8 @@ contains
! !
mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l
if (info == 0) call psb_spmm(-zone,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,& if (info == 0) call psb_spmm(-zone,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,&
& zone,mlprec_wrk(1)%ty,baseprecv(1)%base_desc,info,work=work) & zone,mlprec_wrk(1)%ty,baseprecv(1)%base_desc,info,&
& work=work,trans=trans)
if (info /=0) then if (info /=0) then
call psb_errpush(4010,name,a_err='Fine level baseprec/residual') call psb_errpush(4010,name,a_err='Fine level baseprec/residual')
goto 9999 goto 9999
@ -1298,7 +1299,7 @@ contains
! !
if (info == 0) call mld_baseprec_aply(zone,baseprecv(ilev),& if (info == 0) call mld_baseprec_aply(zone,baseprecv(ilev),&
& mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,&
&baseprecv(ilev)%desc_data, 'N',work,info) &baseprecv(ilev)%desc_data,trans,work,info)
! !
! Compute the residual (at all levels but the coarsest one) ! Compute the residual (at all levels but the coarsest one)
! !
@ -1306,7 +1307,7 @@ contains
mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l
if (info == 0) call psb_spmm(-zone,baseprecv(ilev)%base_a,& if (info == 0) call psb_spmm(-zone,baseprecv(ilev)%base_a,&
& mlprec_wrk(ilev)%y2l,zone,mlprec_wrk(ilev)%ty,& & mlprec_wrk(ilev)%y2l,zone,mlprec_wrk(ilev)%ty,&
& baseprecv(ilev)%base_desc,info,work=work) & baseprecv(ilev)%base_desc,info,work=work,trans=trans)
endif endif
if (info /=0) then if (info /=0) then
call psb_errpush(4001,name,a_err='baseprec_aply/residual') call psb_errpush(4001,name,a_err='baseprec_aply/residual')
@ -1352,7 +1353,8 @@ contains
! Compute the residual ! Compute the residual
! !
call psb_spmm(-zone,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,& call psb_spmm(-zone,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,&
& zone,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,work=work) & zone,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,&
& work=work,trans=trans)
! !
! Apply the base preconditioner ! Apply the base preconditioner
! !

Write Preview
Loading…
Cancel
Save