From 837a5b1a1da7bb08b6ab56750dc4bc17315441fb Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Wed, 29 Apr 2020 16:57:51 +0200 Subject: [PATCH] Added default behavior and psb_toupper function in string check --- .../mld_c_jac_smoother_apply_vect.f90 | 2 +- .../impl/smoother/mld_c_jac_smoother_bld.f90 | 2 +- .../smoother/mld_c_jac_smoother_csetc.f90 | 4 ++-- .../mld_d_jac_smoother_apply_vect.f90 | 2 +- .../impl/smoother/mld_d_jac_smoother_bld.f90 | 2 +- .../smoother/mld_d_jac_smoother_csetc.f90 | 4 ++-- .../mld_s_jac_smoother_apply_vect.f90 | 2 +- .../impl/smoother/mld_s_jac_smoother_bld.f90 | 2 +- .../smoother/mld_s_jac_smoother_csetc.f90 | 4 ++-- .../mld_z_jac_smoother_apply_vect.f90 | 2 +- .../impl/smoother/mld_z_jac_smoother_bld.f90 | 2 +- .../smoother/mld_z_jac_smoother_csetc.f90 | 4 ++-- mlprec/mld_c_jac_smoother.f90 | 24 +++++++++++++++++++ mlprec/mld_d_jac_smoother.f90 | 24 +++++++++++++++++++ mlprec/mld_s_jac_smoother.f90 | 24 +++++++++++++++++++ mlprec/mld_z_jac_smoother.f90 | 24 +++++++++++++++++++ 16 files changed, 112 insertions(+), 16 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 index 94bc1bdc..37529504 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 @@ -39,7 +39,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& & sweeps,work,wv,info,init,initu) use psb_base_mod - use psb_base_krylov_conv_mod + use psb_base_krylov_conv_mod, only : log_conv use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_apply_vect implicit none type(psb_desc_type), intent(in) :: desc_data diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 index f9615361..556d7fe2 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 @@ -73,7 +73,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) nztota = a%get_nzeros() if( sm%checkres ) sm%pa => a - + select type (smsv => sm%sv) class is (mld_c_diag_solver_type) call sm%nd%free() diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 index 7a7a3051..87072c88 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 @@ -55,13 +55,13 @@ subroutine mld_c_jac_smoother_csetc(sm,what,val,info,idx) select case(psb_toupper(what)) case('SMOOTHER_STOP') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%checkres = .true. else sm%checkres = .false. end if case('SMOOTHER_TRACE') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%printres = .true. else sm%printres = .false. diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 index 485ab603..a50ff90d 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 @@ -39,7 +39,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& & sweeps,work,wv,info,init,initu) use psb_base_mod - use psb_base_krylov_conv_mod + use psb_base_krylov_conv_mod, only : log_conv use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_apply_vect implicit none type(psb_desc_type), intent(in) :: desc_data diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index dc09edb3..b1d44b6a 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -73,7 +73,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) nztota = a%get_nzeros() if( sm%checkres ) sm%pa => a - + select type (smsv => sm%sv) class is (mld_d_diag_solver_type) call sm%nd%free() diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 index 17e27ffc..647a80cf 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 @@ -55,13 +55,13 @@ subroutine mld_d_jac_smoother_csetc(sm,what,val,info,idx) select case(psb_toupper(what)) case('SMOOTHER_STOP') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%checkres = .true. else sm%checkres = .false. end if case('SMOOTHER_TRACE') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%printres = .true. else sm%printres = .false. diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 index 5fb33878..3da8b8b3 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 @@ -39,7 +39,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& & sweeps,work,wv,info,init,initu) use psb_base_mod - use psb_base_krylov_conv_mod + use psb_base_krylov_conv_mod, only : log_conv use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_apply_vect implicit none type(psb_desc_type), intent(in) :: desc_data diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 index 958c7f28..c37ca90d 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 @@ -73,7 +73,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) nztota = a%get_nzeros() if( sm%checkres ) sm%pa => a - + select type (smsv => sm%sv) class is (mld_s_diag_solver_type) call sm%nd%free() diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 index 03609c97..154e4cc9 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 @@ -55,13 +55,13 @@ subroutine mld_s_jac_smoother_csetc(sm,what,val,info,idx) select case(psb_toupper(what)) case('SMOOTHER_STOP') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%checkres = .true. else sm%checkres = .false. end if case('SMOOTHER_TRACE') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%printres = .true. else sm%printres = .false. diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 index 72a13101..68d9eb7d 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 @@ -39,7 +39,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& & sweeps,work,wv,info,init,initu) use psb_base_mod - use psb_base_krylov_conv_mod + use psb_base_krylov_conv_mod, only : log_conv use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_apply_vect implicit none type(psb_desc_type), intent(in) :: desc_data diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 index 46d524c9..b723201f 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 @@ -73,7 +73,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) nztota = a%get_nzeros() if( sm%checkres ) sm%pa => a - + select type (smsv => sm%sv) class is (mld_z_diag_solver_type) call sm%nd%free() diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 index ed8a3d38..1867df87 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 @@ -55,13 +55,13 @@ subroutine mld_z_jac_smoother_csetc(sm,what,val,info,idx) select case(psb_toupper(what)) case('SMOOTHER_STOP') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%checkres = .true. else sm%checkres = .false. end if case('SMOOTHER_TRACE') - if((trim(val) == 'T').or.(trim(val) == 'true')) then + if((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then sm%printres = .true. else sm%printres = .false. diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index d43eabf9..bf0cc250 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -79,6 +79,7 @@ module mld_c_jac_smoother procedure, pass(sm) :: csetr => mld_c_jac_smoother_csetr procedure, pass(sm) :: descr => mld_c_jac_smoother_descr procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof + procedure, pass(sm) :: default => c_jac_smoother_default procedure, pass(sm) :: get_nzeros => c_jac_smoother_get_nzeros procedure, pass(sm) :: get_wrksz => c_jac_smoother_get_wrksize procedure, nopass :: get_fmt => c_jac_smoother_get_fmt @@ -289,6 +290,29 @@ contains return end function c_jac_smoother_sizeof + subroutine c_jac_smoother_default(sm) + + Implicit None + + ! Arguments + class(mld_c_jac_smoother_type), intent(inout) :: sm + + ! + ! Default: BJAC with no residual check + ! + sm%checkres = .false. + sm%printres = .false. + sm%checkiter = -1 + sm%printiter = -1 + sm%tol = 0 + + if (allocated(sm%sv)) then + call sm%sv%default() + end if + + return + end subroutine c_jac_smoother_default + function c_jac_smoother_get_nzeros(sm) result(val) implicit none diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index f6b53433..cf7f9821 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -79,6 +79,7 @@ module mld_d_jac_smoother procedure, pass(sm) :: csetr => mld_d_jac_smoother_csetr procedure, pass(sm) :: descr => mld_d_jac_smoother_descr procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof + procedure, pass(sm) :: default => d_jac_smoother_default procedure, pass(sm) :: get_nzeros => d_jac_smoother_get_nzeros procedure, pass(sm) :: get_wrksz => d_jac_smoother_get_wrksize procedure, nopass :: get_fmt => d_jac_smoother_get_fmt @@ -289,6 +290,29 @@ contains return end function d_jac_smoother_sizeof + subroutine d_jac_smoother_default(sm) + + Implicit None + + ! Arguments + class(mld_d_jac_smoother_type), intent(inout) :: sm + + ! + ! Default: BJAC with no residual check + ! + sm%checkres = .false. + sm%printres = .false. + sm%checkiter = -1 + sm%printiter = -1 + sm%tol = 0 + + if (allocated(sm%sv)) then + call sm%sv%default() + end if + + return + end subroutine d_jac_smoother_default + function d_jac_smoother_get_nzeros(sm) result(val) implicit none diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index 53a312ad..98b44700 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -79,6 +79,7 @@ module mld_s_jac_smoother procedure, pass(sm) :: csetr => mld_s_jac_smoother_csetr procedure, pass(sm) :: descr => mld_s_jac_smoother_descr procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof + procedure, pass(sm) :: default => s_jac_smoother_default procedure, pass(sm) :: get_nzeros => s_jac_smoother_get_nzeros procedure, pass(sm) :: get_wrksz => s_jac_smoother_get_wrksize procedure, nopass :: get_fmt => s_jac_smoother_get_fmt @@ -289,6 +290,29 @@ contains return end function s_jac_smoother_sizeof + subroutine s_jac_smoother_default(sm) + + Implicit None + + ! Arguments + class(mld_s_jac_smoother_type), intent(inout) :: sm + + ! + ! Default: BJAC with no residual check + ! + sm%checkres = .false. + sm%printres = .false. + sm%checkiter = -1 + sm%printiter = -1 + sm%tol = 0 + + if (allocated(sm%sv)) then + call sm%sv%default() + end if + + return + end subroutine s_jac_smoother_default + function s_jac_smoother_get_nzeros(sm) result(val) implicit none diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index f14f88ec..52b4fa29 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -79,6 +79,7 @@ module mld_z_jac_smoother procedure, pass(sm) :: csetr => mld_z_jac_smoother_csetr procedure, pass(sm) :: descr => mld_z_jac_smoother_descr procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof + procedure, pass(sm) :: default => z_jac_smoother_default procedure, pass(sm) :: get_nzeros => z_jac_smoother_get_nzeros procedure, pass(sm) :: get_wrksz => z_jac_smoother_get_wrksize procedure, nopass :: get_fmt => z_jac_smoother_get_fmt @@ -289,6 +290,29 @@ contains return end function z_jac_smoother_sizeof + subroutine z_jac_smoother_default(sm) + + Implicit None + + ! Arguments + class(mld_z_jac_smoother_type), intent(inout) :: sm + + ! + ! Default: BJAC with no residual check + ! + sm%checkres = .false. + sm%printres = .false. + sm%checkiter = -1 + sm%printiter = -1 + sm%tol = 0 + + if (allocated(sm%sv)) then + call sm%sv%default() + end if + + return + end subroutine z_jac_smoother_default + function z_jac_smoother_get_nzeros(sm) result(val) implicit none