From 95a3b66a947385f0e02166d58e6d510fe04d3855 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 4 Jan 2008 18:42:04 +0000 Subject: [PATCH] Fixed passing of TRANS down the call chain. --- mlprec/mld_dmlprec_aply.f90 | 32 +++++++++++++++++--------------- mlprec/mld_zmlprec_aply.f90 | 32 +++++++++++++++++--------------- 2 files changed, 34 insertions(+), 30 deletions(-) diff --git a/mlprec/mld_dmlprec_aply.f90 b/mlprec/mld_dmlprec_aply.f90 index 28abe344..40e348d0 100644 --- a/mlprec/mld_dmlprec_aply.f90 +++ b/mlprec/mld_dmlprec_aply.f90 @@ -456,7 +456,7 @@ contains ! call mld_baseprec_aply(done,baseprecv(ilev),& & mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,& - & baseprecv(ilev)%desc_data, 'N',work,info) + & baseprecv(ilev)%desc_data, trans,work,info) enddo @@ -636,8 +636,7 @@ contains ! Apply the base preconditioner at the finest level ! call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,& - & dzero,mlprec_wrk(1)%y2l,& - & baseprecv(1)%base_desc,& + & dzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err=' baseprec_aply') @@ -652,7 +651,8 @@ contains mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l 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 call psb_errpush(4001,name,a_err=' fine level residual') goto 9999 @@ -722,7 +722,7 @@ contains ! Apply the base preconditioner ! 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) @@ -731,7 +731,7 @@ contains mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,& & 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 if (info /=0) then 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 ! 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 call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -1044,13 +1044,14 @@ contains ! Compute the residual ! 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 ! 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 call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') goto 9999 @@ -1212,8 +1213,7 @@ contains ! Apply the base preconditioner at the finest level ! call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,& - & dzero,mlprec_wrk(1)%y2l,& - & baseprecv(1)%base_desc,& + & dzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,& & trans,work,info) ! ! STEP 3 @@ -1222,7 +1222,8 @@ contains ! mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l 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 call psb_errpush(4010,name,a_err='Fine level baseprec/residual') goto 9999 @@ -1296,7 +1297,7 @@ contains ! if (info == 0) call mld_baseprec_aply(done,baseprecv(ilev),& & 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) ! @@ -1304,7 +1305,7 @@ contains mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,& & 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 if (info /=0) then call psb_errpush(4001,name,a_err='baseprec_aply/residual') @@ -1350,7 +1351,8 @@ contains ! Compute the residual ! 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 ! diff --git a/mlprec/mld_zmlprec_aply.f90 b/mlprec/mld_zmlprec_aply.f90 index 430bfcdf..277ef686 100644 --- a/mlprec/mld_zmlprec_aply.f90 +++ b/mlprec/mld_zmlprec_aply.f90 @@ -457,7 +457,7 @@ contains ! call mld_baseprec_aply(zone,baseprecv(ilev),& & mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%y2l,& - & baseprecv(ilev)%desc_data, 'N',work,info) + & baseprecv(ilev)%desc_data,trans,work,info) enddo @@ -637,8 +637,7 @@ contains ! Apply the base preconditioner at the finest level ! call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,& - & zzero,mlprec_wrk(1)%y2l,& - & baseprecv(1)%base_desc,& + & zzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,& & trans,work,info) if (info /=0) then call psb_errpush(4010,name,a_err=' baseprec_aply') @@ -653,7 +652,8 @@ contains mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l 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 call psb_errpush(4001,name,a_err=' fine level residual') goto 9999 @@ -723,7 +723,7 @@ contains ! Apply the base preconditioner ! 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) @@ -732,7 +732,7 @@ contains mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l if (info == 0) call psb_spmm(-zone,baseprecv(ilev)%base_a,& & 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 if (info /=0) then 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 ! 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 call psb_errpush(4010,name,a_err='baseprec_aply') goto 9999 @@ -1044,13 +1044,14 @@ contains ! Compute the residual ! 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 ! 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 call psb_errpush(4001,name,a_err=' spmm/baseprec_aply') goto 9999 @@ -1213,8 +1214,7 @@ contains ! Apply the base preconditioner at the finest level ! call mld_baseprec_aply(zone,baseprecv(1),mlprec_wrk(1)%x2l,& - & zzero,mlprec_wrk(1)%y2l,& - & baseprecv(1)%base_desc,& + & zzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,& & trans,work,info) ! ! STEP 3 @@ -1223,7 +1223,8 @@ contains ! mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l 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 call psb_errpush(4010,name,a_err='Fine level baseprec/residual') goto 9999 @@ -1298,7 +1299,7 @@ contains ! if (info == 0) call mld_baseprec_aply(zone,baseprecv(ilev),& & 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) ! @@ -1306,7 +1307,7 @@ contains mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l if (info == 0) call psb_spmm(-zone,baseprecv(ilev)%base_a,& & 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 if (info /=0) then call psb_errpush(4001,name,a_err='baseprec_aply/residual') @@ -1352,7 +1353,8 @@ contains ! Compute the residual ! 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 !