Added default behavior and psb_toupper function in string check

stopcriterion
Cirdans-Home 5 years ago
parent 6ac3e6c146
commit 837a5b1a1d

@ -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) & sweeps,work,wv,info,init,initu)
use psb_base_mod 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 use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data

@ -73,7 +73,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
nztota = a%get_nzeros() nztota = a%get_nzeros()
if( sm%checkres ) sm%pa => a if( sm%checkres ) sm%pa => a
select type (smsv => sm%sv) select type (smsv => sm%sv)
class is (mld_c_diag_solver_type) class is (mld_c_diag_solver_type)
call sm%nd%free() call sm%nd%free()

@ -55,13 +55,13 @@ subroutine mld_c_jac_smoother_csetc(sm,what,val,info,idx)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_STOP') 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. sm%checkres = .true.
else else
sm%checkres = .false. sm%checkres = .false.
end if end if
case('SMOOTHER_TRACE') 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. sm%printres = .true.
else else
sm%printres = .false. sm%printres = .false.

@ -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) & sweeps,work,wv,info,init,initu)
use psb_base_mod 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 use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data

@ -73,7 +73,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
nztota = a%get_nzeros() nztota = a%get_nzeros()
if( sm%checkres ) sm%pa => a if( sm%checkres ) sm%pa => a
select type (smsv => sm%sv) select type (smsv => sm%sv)
class is (mld_d_diag_solver_type) class is (mld_d_diag_solver_type)
call sm%nd%free() call sm%nd%free()

@ -55,13 +55,13 @@ subroutine mld_d_jac_smoother_csetc(sm,what,val,info,idx)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_STOP') 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. sm%checkres = .true.
else else
sm%checkres = .false. sm%checkres = .false.
end if end if
case('SMOOTHER_TRACE') 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. sm%printres = .true.
else else
sm%printres = .false. sm%printres = .false.

@ -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) & sweeps,work,wv,info,init,initu)
use psb_base_mod 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 use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data

@ -73,7 +73,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
nztota = a%get_nzeros() nztota = a%get_nzeros()
if( sm%checkres ) sm%pa => a if( sm%checkres ) sm%pa => a
select type (smsv => sm%sv) select type (smsv => sm%sv)
class is (mld_s_diag_solver_type) class is (mld_s_diag_solver_type)
call sm%nd%free() call sm%nd%free()

@ -55,13 +55,13 @@ subroutine mld_s_jac_smoother_csetc(sm,what,val,info,idx)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_STOP') 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. sm%checkres = .true.
else else
sm%checkres = .false. sm%checkres = .false.
end if end if
case('SMOOTHER_TRACE') 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. sm%printres = .true.
else else
sm%printres = .false. sm%printres = .false.

@ -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) & sweeps,work,wv,info,init,initu)
use psb_base_mod 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 use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_apply_vect
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_data type(psb_desc_type), intent(in) :: desc_data

@ -73,7 +73,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
nztota = a%get_nzeros() nztota = a%get_nzeros()
if( sm%checkres ) sm%pa => a if( sm%checkres ) sm%pa => a
select type (smsv => sm%sv) select type (smsv => sm%sv)
class is (mld_z_diag_solver_type) class is (mld_z_diag_solver_type)
call sm%nd%free() call sm%nd%free()

@ -55,13 +55,13 @@ subroutine mld_z_jac_smoother_csetc(sm,what,val,info,idx)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_STOP') 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. sm%checkres = .true.
else else
sm%checkres = .false. sm%checkres = .false.
end if end if
case('SMOOTHER_TRACE') 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. sm%printres = .true.
else else
sm%printres = .false. sm%printres = .false.

@ -79,6 +79,7 @@ module mld_c_jac_smoother
procedure, pass(sm) :: csetr => mld_c_jac_smoother_csetr procedure, pass(sm) :: csetr => mld_c_jac_smoother_csetr
procedure, pass(sm) :: descr => mld_c_jac_smoother_descr procedure, pass(sm) :: descr => mld_c_jac_smoother_descr
procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof 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_nzeros => c_jac_smoother_get_nzeros
procedure, pass(sm) :: get_wrksz => c_jac_smoother_get_wrksize procedure, pass(sm) :: get_wrksz => c_jac_smoother_get_wrksize
procedure, nopass :: get_fmt => c_jac_smoother_get_fmt procedure, nopass :: get_fmt => c_jac_smoother_get_fmt
@ -289,6 +290,29 @@ contains
return return
end function c_jac_smoother_sizeof 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) function c_jac_smoother_get_nzeros(sm) result(val)
implicit none implicit none

@ -79,6 +79,7 @@ module mld_d_jac_smoother
procedure, pass(sm) :: csetr => mld_d_jac_smoother_csetr procedure, pass(sm) :: csetr => mld_d_jac_smoother_csetr
procedure, pass(sm) :: descr => mld_d_jac_smoother_descr procedure, pass(sm) :: descr => mld_d_jac_smoother_descr
procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof 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_nzeros => d_jac_smoother_get_nzeros
procedure, pass(sm) :: get_wrksz => d_jac_smoother_get_wrksize procedure, pass(sm) :: get_wrksz => d_jac_smoother_get_wrksize
procedure, nopass :: get_fmt => d_jac_smoother_get_fmt procedure, nopass :: get_fmt => d_jac_smoother_get_fmt
@ -289,6 +290,29 @@ contains
return return
end function d_jac_smoother_sizeof 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) function d_jac_smoother_get_nzeros(sm) result(val)
implicit none implicit none

@ -79,6 +79,7 @@ module mld_s_jac_smoother
procedure, pass(sm) :: csetr => mld_s_jac_smoother_csetr procedure, pass(sm) :: csetr => mld_s_jac_smoother_csetr
procedure, pass(sm) :: descr => mld_s_jac_smoother_descr procedure, pass(sm) :: descr => mld_s_jac_smoother_descr
procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof 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_nzeros => s_jac_smoother_get_nzeros
procedure, pass(sm) :: get_wrksz => s_jac_smoother_get_wrksize procedure, pass(sm) :: get_wrksz => s_jac_smoother_get_wrksize
procedure, nopass :: get_fmt => s_jac_smoother_get_fmt procedure, nopass :: get_fmt => s_jac_smoother_get_fmt
@ -289,6 +290,29 @@ contains
return return
end function s_jac_smoother_sizeof 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) function s_jac_smoother_get_nzeros(sm) result(val)
implicit none implicit none

@ -79,6 +79,7 @@ module mld_z_jac_smoother
procedure, pass(sm) :: csetr => mld_z_jac_smoother_csetr procedure, pass(sm) :: csetr => mld_z_jac_smoother_csetr
procedure, pass(sm) :: descr => mld_z_jac_smoother_descr procedure, pass(sm) :: descr => mld_z_jac_smoother_descr
procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof 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_nzeros => z_jac_smoother_get_nzeros
procedure, pass(sm) :: get_wrksz => z_jac_smoother_get_wrksize procedure, pass(sm) :: get_wrksz => z_jac_smoother_get_wrksize
procedure, nopass :: get_fmt => z_jac_smoother_get_fmt procedure, nopass :: get_fmt => z_jac_smoother_get_fmt
@ -289,6 +290,29 @@ contains
return return
end function z_jac_smoother_sizeof 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) function z_jac_smoother_get_nzeros(sm) result(val)
implicit none implicit none

Loading…
Cancel
Save