diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 index 74bb5769..f17f50a6 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! MLD2P4 version 2.2 ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! +! +! (C) Copyright 2008-2018 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Daniela di Serafino +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the MLD2P4 group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,10 +33,10 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! subroutine mld_c_jac_smoother_clone(sm,smout,info) - + use psb_base_mod use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_clone @@ -59,14 +59,19 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info) end if if (info == psb_success_) & & allocate(mld_c_jac_smoother_type :: smout, stat=info) - if (info /= 0) then + if (info /= 0) then info = psb_err_alloc_dealloc_ - goto 9999 + goto 9999 end if select type(smo => smout) type is (mld_c_jac_smoother_type) smo%nd_nnz_tot = sm%nd_nnz_tot + smo%checkres = sm%checkres + smo%printres = sm%printres + smo%checkiter = sm%checkiter + smo%printiter = sm%printiter + smo%tol = sm%tol call sm%nd%clone(smo%nd,info) if ((info==psb_success_).and.(allocated(sm%sv))) then allocate(smout%sv,mold=sm%sv,stat=info) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 index 87072c88..b021e074 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_csetc.f90 @@ -52,22 +52,27 @@ subroutine mld_c_jac_smoother_csetc(sm,what,val,info,idx) info = psb_success_ call psb_erractionsave(err_act) - - select case(psb_toupper(what)) - case('SMOOTHER_STOP') - 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((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then - sm%printres = .true. - else - sm%printres = .false. - end if - case default - call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx) + select case(psb_toupper(trim(what))) + case('SMOOTHER_STOP') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%checkres = .true. + case('F','FALSE') + sm%checkres = .false. + case default + write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"' + end select + case('SMOOTHER_TRACE') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%printres = .true. + case('F','FALSE') + sm%printres = .false. + case default + write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"' + end select + case default + call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx) end select if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 index 74e75f07..caa88534 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! MLD2P4 version 2.2 ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! +! +! (C) Copyright 2008-2018 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Daniela di Serafino +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the MLD2P4 group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,10 +33,10 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! subroutine mld_d_jac_smoother_clone(sm,smout,info) - + use psb_base_mod use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_clone @@ -59,14 +59,19 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info) end if if (info == psb_success_) & & allocate(mld_d_jac_smoother_type :: smout, stat=info) - if (info /= 0) then + if (info /= 0) then info = psb_err_alloc_dealloc_ - goto 9999 + goto 9999 end if select type(smo => smout) type is (mld_d_jac_smoother_type) smo%nd_nnz_tot = sm%nd_nnz_tot + smo%checkres = sm%checkres + smo%printres = sm%printres + smo%checkiter = sm%checkiter + smo%printiter = sm%printiter + smo%tol = sm%tol call sm%nd%clone(smo%nd,info) if ((info==psb_success_).and.(allocated(sm%sv))) then allocate(smout%sv,mold=sm%sv,stat=info) diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 index 647a80cf..aba40147 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_csetc.f90 @@ -52,22 +52,27 @@ subroutine mld_d_jac_smoother_csetc(sm,what,val,info,idx) info = psb_success_ call psb_erractionsave(err_act) - - select case(psb_toupper(what)) - case('SMOOTHER_STOP') - 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((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then - sm%printres = .true. - else - sm%printres = .false. - end if - case default - call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx) + select case(psb_toupper(trim(what))) + case('SMOOTHER_STOP') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%checkres = .true. + case('F','FALSE') + sm%checkres = .false. + case default + write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"' + end select + case('SMOOTHER_TRACE') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%printres = .true. + case('F','FALSE') + sm%printres = .false. + case default + write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"' + end select + case default + call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx) end select if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 index e311a601..a0b6c349 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! MLD2P4 version 2.2 ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! +! +! (C) Copyright 2008-2018 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Daniela di Serafino +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the MLD2P4 group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,10 +33,10 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! subroutine mld_s_jac_smoother_clone(sm,smout,info) - + use psb_base_mod use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_clone @@ -59,14 +59,19 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info) end if if (info == psb_success_) & & allocate(mld_s_jac_smoother_type :: smout, stat=info) - if (info /= 0) then + if (info /= 0) then info = psb_err_alloc_dealloc_ - goto 9999 + goto 9999 end if select type(smo => smout) type is (mld_s_jac_smoother_type) smo%nd_nnz_tot = sm%nd_nnz_tot + smo%checkres = sm%checkres + smo%printres = sm%printres + smo%checkiter = sm%checkiter + smo%printiter = sm%printiter + smo%tol = sm%tol call sm%nd%clone(smo%nd,info) if ((info==psb_success_).and.(allocated(sm%sv))) then allocate(smout%sv,mold=sm%sv,stat=info) diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 index 154e4cc9..4f88efbd 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_csetc.f90 @@ -52,22 +52,27 @@ subroutine mld_s_jac_smoother_csetc(sm,what,val,info,idx) info = psb_success_ call psb_erractionsave(err_act) - - select case(psb_toupper(what)) - case('SMOOTHER_STOP') - 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((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then - sm%printres = .true. - else - sm%printres = .false. - end if - case default - call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx) + select case(psb_toupper(trim(what))) + case('SMOOTHER_STOP') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%checkres = .true. + case('F','FALSE') + sm%checkres = .false. + case default + write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"' + end select + case('SMOOTHER_TRACE') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%printres = .true. + case('F','FALSE') + sm%printres = .false. + case default + write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"' + end select + case default + call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx) end select if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 index 19eeacda..5e2b54f8 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! MLD2P4 version 2.2 ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! +! +! (C) Copyright 2008-2018 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Daniela di Serafino +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the MLD2P4 group or the names of its contributors may ! not be used to endorse or promote products derived from this ! software without specific written permission. -! +! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR @@ -33,10 +33,10 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! subroutine mld_z_jac_smoother_clone(sm,smout,info) - + use psb_base_mod use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_clone @@ -59,14 +59,19 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info) end if if (info == psb_success_) & & allocate(mld_z_jac_smoother_type :: smout, stat=info) - if (info /= 0) then + if (info /= 0) then info = psb_err_alloc_dealloc_ - goto 9999 + goto 9999 end if select type(smo => smout) type is (mld_z_jac_smoother_type) smo%nd_nnz_tot = sm%nd_nnz_tot + smo%checkres = sm%checkres + smo%printres = sm%printres + smo%checkiter = sm%checkiter + smo%printiter = sm%printiter + smo%tol = sm%tol call sm%nd%clone(smo%nd,info) if ((info==psb_success_).and.(allocated(sm%sv))) then allocate(smout%sv,mold=sm%sv,stat=info) diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 index 1867df87..9e9cc0f9 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_csetc.f90 @@ -52,22 +52,27 @@ subroutine mld_z_jac_smoother_csetc(sm,what,val,info,idx) info = psb_success_ call psb_erractionsave(err_act) - - select case(psb_toupper(what)) - case('SMOOTHER_STOP') - 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((psb_toupper(trim(val)) == 'T').or.(psb_toupper(trim(val)) == 'TRUE')) then - sm%printres = .true. - else - sm%printres = .false. - end if - case default - call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx) + select case(psb_toupper(trim(what))) + case('SMOOTHER_STOP') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%checkres = .true. + case('F','FALSE') + sm%checkres = .false. + case default + write(0,*) 'Unknown value for smoother_stop : "',psb_toupper(trim(val)),'"' + end select + case('SMOOTHER_TRACE') + select case(psb_toupper(trim(val))) + case('T','TRUE') + sm%printres = .true. + case('F','FALSE') + sm%printres = .false. + case default + write(0,*) 'Unknown value for smoother_trace : "',psb_toupper(trim(val)),'"' + end select + case default + call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx) end select if (info /= psb_success_) then