From 62cb1e86e8b72e99abe3b23bb059eac4de92d5ab Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 19 Jun 2018 12:04:34 +0100 Subject: [PATCH] Temp fix for ext_prol with LPK8. --- ...mld_c_extprol_bld.f90 => mld_c_extprol_bld.F90} | 14 +++++++++++++- ...mld_d_extprol_bld.f90 => mld_d_extprol_bld.F90} | 14 +++++++++++++- ...mld_s_extprol_bld.f90 => mld_s_extprol_bld.F90} | 14 +++++++++++++- ...mld_z_extprol_bld.f90 => mld_z_extprol_bld.F90} | 14 +++++++++++++- 4 files changed, 52 insertions(+), 4 deletions(-) rename mlprec/impl/{mld_c_extprol_bld.f90 => mld_c_extprol_bld.F90} (98%) rename mlprec/impl/{mld_d_extprol_bld.f90 => mld_d_extprol_bld.F90} (98%) rename mlprec/impl/{mld_s_extprol_bld.f90 => mld_s_extprol_bld.F90} (98%) rename mlprec/impl/{mld_z_extprol_bld.f90 => mld_z_extprol_bld.F90} (98%) diff --git a/mlprec/impl/mld_c_extprol_bld.f90 b/mlprec/impl/mld_c_extprol_bld.F90 similarity index 98% rename from mlprec/impl/mld_c_extprol_bld.f90 rename to mlprec/impl/mld_c_extprol_bld.F90 index f28e1556..9b5e76dc 100644 --- a/mlprec/impl/mld_c_extprol_bld.f90 +++ b/mlprec/impl/mld_c_extprol_bld.F90 @@ -124,6 +124,12 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else + ! ! For the time being we are commenting out the UPDATE argument ! we plan to resurrect it later. @@ -321,6 +327,7 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' +#endif call psb_erractionrestore(err_act) return @@ -360,6 +367,11 @@ contains info = psb_success_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 @@ -506,7 +518,7 @@ contains call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') goto 9999 end if - +#endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_d_extprol_bld.f90 b/mlprec/impl/mld_d_extprol_bld.F90 similarity index 98% rename from mlprec/impl/mld_d_extprol_bld.f90 rename to mlprec/impl/mld_d_extprol_bld.F90 index e7a13942..c7ff4de8 100644 --- a/mlprec/impl/mld_d_extprol_bld.f90 +++ b/mlprec/impl/mld_d_extprol_bld.F90 @@ -124,6 +124,12 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else + ! ! For the time being we are commenting out the UPDATE argument ! we plan to resurrect it later. @@ -321,6 +327,7 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' +#endif call psb_erractionrestore(err_act) return @@ -360,6 +367,11 @@ contains info = psb_success_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 @@ -506,7 +518,7 @@ contains call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') goto 9999 end if - +#endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_s_extprol_bld.f90 b/mlprec/impl/mld_s_extprol_bld.F90 similarity index 98% rename from mlprec/impl/mld_s_extprol_bld.f90 rename to mlprec/impl/mld_s_extprol_bld.F90 index 4feb6d82..f8d74155 100644 --- a/mlprec/impl/mld_s_extprol_bld.f90 +++ b/mlprec/impl/mld_s_extprol_bld.F90 @@ -124,6 +124,12 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else + ! ! For the time being we are commenting out the UPDATE argument ! we plan to resurrect it later. @@ -321,6 +327,7 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' +#endif call psb_erractionrestore(err_act) return @@ -360,6 +367,11 @@ contains info = psb_success_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 @@ -506,7 +518,7 @@ contains call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') goto 9999 end if - +#endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_z_extprol_bld.f90 b/mlprec/impl/mld_z_extprol_bld.F90 similarity index 98% rename from mlprec/impl/mld_z_extprol_bld.f90 rename to mlprec/impl/mld_z_extprol_bld.F90 index 95a1ff27..89e6299e 100644 --- a/mlprec/impl/mld_z_extprol_bld.f90 +++ b/mlprec/impl/mld_z_extprol_bld.F90 @@ -124,6 +124,12 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else + ! ! For the time being we are commenting out the UPDATE argument ! we plan to resurrect it later. @@ -321,6 +327,7 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' +#endif call psb_erractionrestore(err_act) return @@ -360,6 +367,11 @@ contains info = psb_success_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) +#if defined(LPK8) + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err='Need fix for LPK8') + goto 9999 +#else allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 @@ -506,7 +518,7 @@ contains call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') goto 9999 end if - +#endif call psb_erractionrestore(err_act) return