diff --git a/prec/Makefile b/prec/Makefile index 47528dd4..e7f9dcda 100644 --- a/prec/Makefile +++ b/prec/Makefile @@ -4,6 +4,7 @@ LIBDIR=../lib HERE=. MODOBJS=psb_prec_const_mod.o\ psb_s_prec_type.o psb_d_prec_type.o psb_c_prec_type.o psb_z_prec_type.o \ + psb_s_base_prec_mod.o psb_d_base_prec_mod.o psb_c_base_prec_mod.o psb_z_base_prec_mod.o \ psb_prec_type.o psb_prec_mod.o\ psb_d_diagprec.o psb_d_nullprec.o psb_d_bjacprec.o \ psb_s_diagprec.o psb_s_nullprec.o psb_s_bjacprec.o \ @@ -36,13 +37,17 @@ $(OBJS): $(LIBDIR)/psb_sparse_mod$(.mod) $(F90OBJS): $(MODOBJS) -psb_s_prec_type.o psb_d_prec_type.o psb_c_prec_type.o psb_z_prec_type.o: psb_prec_const_mod.o +psb_s_base_prec_mod.o psb_d_base_prec_mod.o psb_c_base_prec_mod.o psb_z_base_prec_mod.o: psb_prec_const_mod.o +psb_s_prec_type.o: psb_s_base_prec_mod.o +psb_d_prec_type.o: psb_d_base_prec_mod.o +psb_c_prec_type.o: psb_c_base_prec_mod.o +psb_z_prec_type.o: psb_z_base_prec_mod.o psb_prec_type.o: psb_s_prec_type.o psb_d_prec_type.o psb_c_prec_type.o psb_z_prec_type.o psb_prec_mod.o: psb_prec_type.o -psb_s_bjacprec.o psb_s_diagprec.o psb_s_nullprec.o: psb_prec_type.o psb_prec_mod.o -psb_d_bjacprec.o psb_d_diagprec.o psb_d_nullprec.o: psb_prec_type.o psb_prec_mod.o -psb_c_bjacprec.o psb_c_diagprec.o psb_c_nullprec.o: psb_prec_type.o psb_prec_mod.o -psb_z_bjacprec.o psb_z_diagprec.o psb_z_nullprec.o: psb_prec_type.o psb_prec_mod.o +psb_s_bjacprec.o psb_s_diagprec.o psb_s_nullprec.o: psb_s_base_prec_mod.o +psb_d_bjacprec.o psb_d_diagprec.o psb_d_nullprec.o: psb_d_base_prec_mod.o +psb_c_bjacprec.o psb_c_diagprec.o psb_c_nullprec.o: psb_c_base_prec_mod.o +psb_z_bjacprec.o psb_z_diagprec.o psb_z_nullprec.o: psb_z_base_prec_mod.o veryclean: clean /bin/rm -f $(LIBNAME) diff --git a/prec/psb_c_base_prec_mod.f03 b/prec/psb_c_base_prec_mod.f03 new file mode 100644 index 00000000..33a261e2 --- /dev/null +++ b/prec/psb_c_base_prec_mod.f03 @@ -0,0 +1,351 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS 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 +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Module to define PREC_DATA, !! +!! structure for preconditioning. !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +module psb_c_base_prec_mod + + ! Reduces size of .mod file. + use psb_sparse_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& + & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& + & psb_c_sparse_mat + + use psb_prec_const_mod + + type psb_c_base_prec_type + contains + procedure, pass(prec) :: apply => psb_c_base_apply + procedure, pass(prec) :: precbld => psb_c_base_precbld + procedure, pass(prec) :: precseti => psb_c_base_precseti + procedure, pass(prec) :: precsetr => psb_c_base_precsetr + procedure, pass(prec) :: precsetc => psb_c_base_precsetc + procedure, pass(prec) :: sizeof => psb_c_base_sizeof + generic, public :: precset => precseti, precsetr, precsetc + procedure, pass(prec) :: precinit => psb_c_base_precinit + procedure, pass(prec) :: precfree => psb_c_base_precfree + procedure, pass(prec) :: precdescr => psb_c_base_precdescr + end type psb_c_base_prec_type + + private :: psb_c_base_apply, psb_c_base_precbld, psb_c_base_precseti,& + & psb_c_base_precsetr, psb_c_base_precsetc, psb_c_base_sizeof,& + & psb_c_base_precinit, psb_c_base_precfree, psb_c_base_precdescr + + +contains + + subroutine psb_c_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_sparse_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_c_base_prec_type), intent(in) :: prec + complex(psb_spk_),intent(in) :: alpha, beta + complex(psb_spk_),intent(in) :: x(:) + complex(psb_spk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='c_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_c_base_apply + + subroutine psb_c_base_precinit(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_c_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='c_base_precinit' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_c_base_precinit + + subroutine psb_c_base_precbld(a,desc_a,prec,info,upd) + + use psb_sparse_mod + Implicit None + + type(psb_c_sparse_mat), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + class(psb_c_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + character, intent(in), optional :: upd + Integer :: err_act, nrow + character(len=20) :: name='c_base_precbld' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_c_base_precbld + + subroutine psb_c_base_precseti(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_c_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + integer, intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='c_base_precseti' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_c_base_precseti + + subroutine psb_c_base_precsetr(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_c_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + real(psb_spk_), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='c_base_precsetr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_c_base_precsetr + + subroutine psb_c_base_precsetc(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_c_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + character(len=*), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='c_base_precsetc' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_c_base_precsetc + + subroutine psb_c_base_precfree(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_c_base_prec_type), intent(inout) :: prec + integer, intent(out) :: info + + Integer :: err_act, nrow + character(len=20) :: name='c_base_precfree' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_c_base_precfree + + + subroutine psb_c_base_precdescr(prec,iout) + + use psb_sparse_mod + Implicit None + + class(psb_c_base_prec_type), intent(in) :: prec + integer, intent(in), optional :: iout + + Integer :: err_act, nrow, info + character(len=20) :: name='c_base_precdescr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_c_base_precdescr + + + function psb_c_base_sizeof(prec) result(val) + use psb_sparse_mod + class(psb_c_base_prec_type), intent(in) :: prec + integer(psb_long_int_k_) :: val + + val = 0 + return + end function psb_c_base_sizeof + +end module psb_c_base_prec_mod diff --git a/prec/psb_c_bjacprec.f03 b/prec/psb_c_bjacprec.f03 index 8953ad4a..8d0fb15f 100644 --- a/prec/psb_c_bjacprec.f03 +++ b/prec/psb_c_bjacprec.f03 @@ -1,23 +1,27 @@ module psb_c_bjacprec - use psb_prec_type + use psb_c_base_prec_mod type, extends(psb_c_base_prec_type) :: psb_c_bjac_prec_type integer, allocatable :: iprcparm(:) type(psb_c_sparse_mat), allocatable :: av(:) complex(psb_spk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => c_bjac_apply - procedure, pass(prec) :: precbld => c_bjac_precbld - procedure, pass(prec) :: precinit => c_bjac_precinit - procedure, pass(prec) :: precseti => c_bjac_precseti - procedure, pass(prec) :: precsetr => c_bjac_precsetr - procedure, pass(prec) :: precsetc => c_bjac_precsetc - procedure, pass(prec) :: precfree => c_bjac_precfree - procedure, pass(prec) :: precdescr => c_bjac_precdescr - procedure, pass(prec) :: sizeof => c_bjac_sizeof + procedure, pass(prec) :: apply => psb_c_bjac_apply + procedure, pass(prec) :: precbld => psb_c_bjac_precbld + procedure, pass(prec) :: precinit => psb_c_bjac_precinit + procedure, pass(prec) :: precseti => psb_c_bjac_precseti + procedure, pass(prec) :: precsetr => psb_c_bjac_precsetr + procedure, pass(prec) :: precsetc => psb_c_bjac_precsetc + procedure, pass(prec) :: precfree => psb_c_bjac_precfree + procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr + procedure, pass(prec) :: sizeof => psb_c_bjac_sizeof end type psb_c_bjac_prec_type + private :: psb_c_bjac_apply, psb_c_bjac_precbld, psb_c_bjac_precseti,& + & psb_c_bjac_precsetr, psb_c_bjac_precsetc, psb_c_bjac_sizeof,& + & psb_c_bjac_precinit, psb_c_bjac_precfree, psb_c_bjac_precdescr + character(len=15), parameter, private :: & & fact_names(0:2)=(/'None ','ILU(n) ',& @@ -26,7 +30,7 @@ module psb_c_bjacprec contains - subroutine c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_c_bjac_prec_type), intent(in) :: prec @@ -170,9 +174,9 @@ contains return - end subroutine c_bjac_apply + end subroutine psb_c_bjac_apply - subroutine c_bjac_precinit(prec,info) + subroutine psb_c_bjac_precinit(prec,info) use psb_sparse_mod Implicit None @@ -208,10 +212,10 @@ contains return end if return - end subroutine c_bjac_precinit + end subroutine psb_c_bjac_precinit - subroutine c_bjac_precbld(a,desc_a,prec,info,upd) + subroutine psb_c_bjac_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod use psb_prec_mod @@ -352,9 +356,9 @@ contains end if return - end subroutine c_bjac_precbld + end subroutine psb_c_bjac_precbld - subroutine c_bjac_precseti(prec,what,val,info) + subroutine psb_c_bjac_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -407,9 +411,9 @@ contains return end if return - end subroutine c_bjac_precseti + end subroutine psb_c_bjac_precseti - subroutine c_bjac_precsetr(prec,what,val,info) + subroutine psb_c_bjac_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -435,9 +439,9 @@ contains return end if return - end subroutine c_bjac_precsetr + end subroutine psb_c_bjac_precsetr - subroutine c_bjac_precsetc(prec,what,val,info) + subroutine psb_c_bjac_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -463,9 +467,9 @@ contains return end if return - end subroutine c_bjac_precsetc + end subroutine psb_c_bjac_precsetc - subroutine c_bjac_precfree(prec,info) + subroutine psb_c_bjac_precfree(prec,info) use psb_sparse_mod Implicit None @@ -499,10 +503,10 @@ contains end if return - end subroutine c_bjac_precfree + end subroutine psb_c_bjac_precfree - subroutine c_bjac_precdescr(prec,iout) + subroutine psb_c_bjac_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -548,9 +552,9 @@ contains end if return - end subroutine c_bjac_precdescr + end subroutine psb_c_bjac_precdescr - function c_bjac_sizeof(prec) result(val) + function psb_c_bjac_sizeof(prec) result(val) use psb_sparse_mod class(psb_c_bjac_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -564,6 +568,6 @@ contains val = val + psb_sizeof(prec%av(psb_u_pr_)) endif return - end function c_bjac_sizeof + end function psb_c_bjac_sizeof end module psb_c_bjacprec diff --git a/prec/psb_c_diagprec.f03 b/prec/psb_c_diagprec.f03 index 7bae0018..29c7e727 100644 --- a/prec/psb_c_diagprec.f03 +++ b/prec/psb_c_diagprec.f03 @@ -1,26 +1,30 @@ module psb_c_diagprec - use psb_prec_type + use psb_c_base_prec_mod type, extends(psb_c_base_prec_type) :: psb_c_diag_prec_type complex(psb_spk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => c_diag_apply - procedure, pass(prec) :: precbld => c_diag_precbld - procedure, pass(prec) :: precinit => c_diag_precinit - procedure, pass(prec) :: precseti => c_diag_precseti - procedure, pass(prec) :: precsetr => c_diag_precsetr - procedure, pass(prec) :: precsetc => c_diag_precsetc - procedure, pass(prec) :: precfree => c_diag_precfree - procedure, pass(prec) :: precdescr => c_diag_precdescr - procedure, pass(prec) :: sizeof => c_diag_sizeof + procedure, pass(prec) :: apply => psb_c_diag_apply + procedure, pass(prec) :: precbld => psb_c_diag_precbld + procedure, pass(prec) :: precinit => psb_c_diag_precinit + procedure, pass(prec) :: precseti => psb_c_diag_precseti + procedure, pass(prec) :: precsetr => psb_c_diag_precsetr + procedure, pass(prec) :: precsetc => psb_c_diag_precsetc + procedure, pass(prec) :: precfree => psb_c_diag_precfree + procedure, pass(prec) :: precdescr => psb_c_diag_precdescr + procedure, pass(prec) :: sizeof => psb_c_diag_sizeof end type psb_c_diag_prec_type + private :: psb_c_diag_apply, psb_c_diag_precbld, psb_c_diag_precseti,& + & psb_c_diag_precsetr, psb_c_diag_precsetc, psb_c_diag_sizeof,& + & psb_c_diag_precinit, psb_c_diag_precfree, psb_c_diag_precdescr + contains - subroutine c_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_c_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_c_diag_prec_type), intent(in) :: prec @@ -119,9 +123,9 @@ contains end if return - end subroutine c_diag_apply + end subroutine psb_c_diag_apply - subroutine c_diag_precinit(prec,info) + subroutine psb_c_diag_precinit(prec,info) use psb_sparse_mod Implicit None @@ -146,10 +150,10 @@ contains return end if return - end subroutine c_diag_precinit + end subroutine psb_c_diag_precinit - subroutine c_diag_precbld(a,desc_a,prec,info,upd) + subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -205,9 +209,9 @@ contains return end if return - end subroutine c_diag_precbld + end subroutine psb_c_diag_precbld - subroutine c_diag_precseti(prec,what,val,info) + subroutine psb_c_diag_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -233,9 +237,9 @@ contains return end if return - end subroutine c_diag_precseti + end subroutine psb_c_diag_precseti - subroutine c_diag_precsetr(prec,what,val,info) + subroutine psb_c_diag_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -261,9 +265,9 @@ contains return end if return - end subroutine c_diag_precsetr + end subroutine psb_c_diag_precsetr - subroutine c_diag_precsetc(prec,what,val,info) + subroutine psb_c_diag_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -289,9 +293,9 @@ contains return end if return - end subroutine c_diag_precsetc + end subroutine psb_c_diag_precsetc - subroutine c_diag_precfree(prec,info) + subroutine psb_c_diag_precfree(prec,info) use psb_sparse_mod Implicit None @@ -317,10 +321,10 @@ contains end if return - end subroutine c_diag_precfree + end subroutine psb_c_diag_precfree - subroutine c_diag_precdescr(prec,iout) + subroutine psb_c_diag_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -360,9 +364,9 @@ contains end if return - end subroutine c_diag_precdescr + end subroutine psb_c_diag_precdescr - function c_diag_sizeof(prec) result(val) + function psb_c_diag_sizeof(prec) result(val) use psb_sparse_mod class(psb_c_diag_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -370,6 +374,6 @@ contains val = 0 val = val + 2*psb_sizeof_sp * size(prec%d) return - end function c_diag_sizeof + end function psb_c_diag_sizeof end module psb_c_diagprec diff --git a/prec/psb_c_nullprec.f03 b/prec/psb_c_nullprec.f03 index b42d8dea..628f8322 100644 --- a/prec/psb_c_nullprec.f03 +++ b/prec/psb_c_nullprec.f03 @@ -1,25 +1,28 @@ module psb_c_nullprec - use psb_prec_type + use psb_c_base_prec_mod type, extends(psb_c_base_prec_type) :: psb_c_null_prec_type contains - procedure, pass(prec) :: apply => c_null_apply - procedure, pass(prec) :: precbld => c_null_precbld - procedure, pass(prec) :: precinit => c_null_precinit - procedure, pass(prec) :: precseti => c_null_precseti - procedure, pass(prec) :: precsetr => c_null_precsetr - procedure, pass(prec) :: precsetc => c_null_precsetc - procedure, pass(prec) :: precfree => c_null_precfree - procedure, pass(prec) :: precdescr => c_null_precdescr - procedure, pass(prec) :: sizeof => c_null_sizeof + procedure, pass(prec) :: apply => psb_c_null_apply + procedure, pass(prec) :: precbld => psb_c_null_precbld + procedure, pass(prec) :: precinit => psb_c_null_precinit + procedure, pass(prec) :: precseti => psb_c_null_precseti + procedure, pass(prec) :: precsetr => psb_c_null_precsetr + procedure, pass(prec) :: precsetc => psb_c_null_precsetc + procedure, pass(prec) :: precfree => psb_c_null_precfree + procedure, pass(prec) :: precdescr => psb_c_null_precdescr + procedure, pass(prec) :: sizeof => psb_c_null_sizeof end type psb_c_null_prec_type - + private :: psb_c_null_apply, psb_c_null_precbld, psb_c_null_precseti,& + & psb_c_null_precsetr, psb_c_null_precsetc, psb_c_null_sizeof,& + & psb_c_null_precinit, psb_c_null_precfree, psb_c_null_precdescr + contains - subroutine c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_c_null_prec_type), intent(in) :: prec @@ -70,10 +73,10 @@ contains end if return - end subroutine c_null_apply + end subroutine psb_c_null_apply - subroutine c_null_precinit(prec,info) + subroutine psb_c_null_precinit(prec,info) use psb_sparse_mod Implicit None @@ -98,9 +101,9 @@ contains return end if return - end subroutine c_null_precinit + end subroutine psb_c_null_precinit - subroutine c_null_precbld(a,desc_a,prec,info,upd) + subroutine psb_c_null_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -128,9 +131,9 @@ contains return end if return - end subroutine c_null_precbld + end subroutine psb_c_null_precbld - subroutine c_null_precseti(prec,what,val,info) + subroutine psb_c_null_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -156,9 +159,9 @@ contains return end if return - end subroutine c_null_precseti + end subroutine psb_c_null_precseti - subroutine c_null_precsetr(prec,what,val,info) + subroutine psb_c_null_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -184,9 +187,9 @@ contains return end if return - end subroutine c_null_precsetr + end subroutine psb_c_null_precsetr - subroutine c_null_precsetc(prec,what,val,info) + subroutine psb_c_null_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -212,9 +215,9 @@ contains return end if return - end subroutine c_null_precsetc + end subroutine psb_c_null_precsetc - subroutine c_null_precfree(prec,info) + subroutine psb_c_null_precfree(prec,info) use psb_sparse_mod Implicit None @@ -240,10 +243,10 @@ contains end if return - end subroutine c_null_precfree + end subroutine psb_c_null_precfree - subroutine c_null_precdescr(prec,iout) + subroutine psb_c_null_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -278,9 +281,9 @@ contains end if return - end subroutine c_null_precdescr + end subroutine psb_c_null_precdescr - function c_null_sizeof(prec) result(val) + function psb_c_null_sizeof(prec) result(val) use psb_sparse_mod class(psb_c_null_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -288,6 +291,6 @@ contains val = 0 return - end function c_null_sizeof + end function psb_c_null_sizeof end module psb_c_nullprec diff --git a/prec/psb_c_prec_type.f03 b/prec/psb_c_prec_type.f03 index 2bc8451c..e5254904 100644 --- a/prec/psb_c_prec_type.f03 +++ b/prec/psb_c_prec_type.f03 @@ -42,22 +42,8 @@ module psb_c_prec_type & psb_c_sparse_mat use psb_prec_const_mod + use psb_c_base_prec_mod - - type psb_c_base_prec_type - contains - procedure, pass(prec) :: apply => c_base_apply - procedure, pass(prec) :: precbld => c_base_precbld - procedure, pass(prec) :: precseti => c_base_precseti - procedure, pass(prec) :: precsetr => c_base_precsetr - procedure, pass(prec) :: precsetc => c_base_precsetc - procedure, pass(prec) :: sizeof => c_base_sizeof - generic, public :: precset => precseti, precsetr, precsetc - procedure, pass(prec) :: precinit => c_base_precinit - procedure, pass(prec) :: precfree => c_base_precfree - procedure, pass(prec) :: precdescr => c_base_precdescr - end type psb_c_base_prec_type - type psb_cprec_type class(psb_c_base_prec_type), allocatable :: prec contains @@ -310,288 +296,4 @@ contains end subroutine c_apply1v - subroutine c_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) - use psb_sparse_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_c_base_prec_type), intent(in) :: prec - complex(psb_spk_),intent(in) :: alpha, beta - complex(psb_spk_),intent(in) :: x(:) - complex(psb_spk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans - complex(psb_spk_),intent(inout), optional, target :: work(:) - Integer :: err_act, nrow - character(len=20) :: name='c_base_prec_apply' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine c_base_apply - - subroutine c_base_precinit(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_c_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='c_base_precinit' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_base_precinit - - subroutine c_base_precbld(a,desc_a,prec,info,upd) - - use psb_sparse_mod - Implicit None - - type(psb_c_sparse_mat), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - class(psb_c_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - character, intent(in), optional :: upd - Integer :: err_act, nrow - character(len=20) :: name='c_base_precbld' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_base_precbld - - subroutine c_base_precseti(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_c_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - integer, intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='c_base_precseti' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_base_precseti - - subroutine c_base_precsetr(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_c_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - real(psb_spk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='c_base_precsetr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_base_precsetr - - subroutine c_base_precsetc(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_c_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='c_base_precsetc' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_base_precsetc - - subroutine c_base_precfree(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_c_base_prec_type), intent(inout) :: prec - integer, intent(out) :: info - - Integer :: err_act, nrow - character(len=20) :: name='c_base_precfree' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine c_base_precfree - - - subroutine c_base_precdescr(prec,iout) - - use psb_sparse_mod - Implicit None - - class(psb_c_base_prec_type), intent(in) :: prec - integer, intent(in), optional :: iout - - Integer :: err_act, nrow, info - character(len=20) :: name='c_base_precdescr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine c_base_precdescr - - - function c_base_sizeof(prec) result(val) - use psb_sparse_mod - class(psb_c_base_prec_type), intent(in) :: prec - integer(psb_long_int_k_) :: val - - val = 0 - return - end function c_base_sizeof - end module psb_c_prec_type diff --git a/prec/psb_d_base_prec_mod.f03 b/prec/psb_d_base_prec_mod.f03 new file mode 100644 index 00000000..4286bb7b --- /dev/null +++ b/prec/psb_d_base_prec_mod.f03 @@ -0,0 +1,352 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS 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 +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Module to define PREC_DATA, !! +!! structure for preconditioning. !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +module psb_d_base_prec_mod + + ! Reduces size of .mod file. + use psb_sparse_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& + & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& + & psb_d_sparse_mat + + + use psb_prec_const_mod + + type psb_d_base_prec_type + contains + procedure, pass(prec) :: apply => psb_d_base_apply + procedure, pass(prec) :: precbld => psb_d_base_precbld + procedure, pass(prec) :: precseti => psb_d_base_precseti + procedure, pass(prec) :: precsetr => psb_d_base_precsetr + procedure, pass(prec) :: precsetc => psb_d_base_precsetc + procedure, pass(prec) :: sizeof => psb_d_base_sizeof + generic, public :: precset => precseti, precsetr, precsetc + procedure, pass(prec) :: precinit => psb_d_base_precinit + procedure, pass(prec) :: precfree => psb_d_base_precfree + procedure, pass(prec) :: precdescr => psb_d_base_precdescr + end type psb_d_base_prec_type + + private :: psb_d_base_apply, psb_d_base_precbld, psb_d_base_precseti,& + & psb_d_base_precsetr, psb_d_base_precsetc, psb_d_base_sizeof,& + & psb_d_base_precinit, psb_d_base_precfree, psb_d_base_precdescr + + +contains + + subroutine psb_d_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_sparse_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_d_base_prec_type), intent(in) :: prec + real(psb_dpk_),intent(in) :: alpha, beta + real(psb_dpk_),intent(in) :: x(:) + real(psb_dpk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_d_base_apply + + subroutine psb_d_base_precinit(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_d_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='d_base_precinit' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_d_base_precinit + + subroutine psb_d_base_precbld(a,desc_a,prec,info,upd) + + use psb_sparse_mod + Implicit None + + type(psb_d_sparse_mat), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + class(psb_d_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + character, intent(in), optional :: upd + Integer :: err_act, nrow + character(len=20) :: name='d_base_precbld' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_d_base_precbld + + subroutine psb_d_base_precseti(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_d_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + integer, intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='d_base_precseti' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_d_base_precseti + + subroutine psb_d_base_precsetr(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_d_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='d_base_precsetr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_d_base_precsetr + + subroutine psb_d_base_precsetc(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_d_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + character(len=*), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='d_base_precsetc' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_d_base_precsetc + + subroutine psb_d_base_precfree(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_d_base_prec_type), intent(inout) :: prec + integer, intent(out) :: info + + Integer :: err_act, nrow + character(len=20) :: name='d_base_precfree' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_d_base_precfree + + + subroutine psb_d_base_precdescr(prec,iout) + + use psb_sparse_mod + Implicit None + + class(psb_d_base_prec_type), intent(in) :: prec + integer, intent(in), optional :: iout + + Integer :: err_act, nrow, info + character(len=20) :: name='d_base_precdescr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_d_base_precdescr + + + function psb_d_base_sizeof(prec) result(val) + use psb_sparse_mod + class(psb_d_base_prec_type), intent(in) :: prec + integer(psb_long_int_k_) :: val + + val = 0 + return + end function psb_d_base_sizeof + +end module psb_d_base_prec_mod diff --git a/prec/psb_d_bjacprec.f03 b/prec/psb_d_bjacprec.f03 index ac4e2d0d..0d85b161 100644 --- a/prec/psb_d_bjacprec.f03 +++ b/prec/psb_d_bjacprec.f03 @@ -1,5 +1,5 @@ module psb_d_bjacprec - use psb_prec_type + use psb_d_base_prec_mod type, extends(psb_d_base_prec_type) :: psb_d_bjac_prec_type @@ -7,17 +7,21 @@ module psb_d_bjacprec type(psb_d_sparse_mat), allocatable :: av(:) real(psb_dpk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => d_bjac_apply - procedure, pass(prec) :: precbld => d_bjac_precbld - procedure, pass(prec) :: precinit => d_bjac_precinit - procedure, pass(prec) :: precseti => d_bjac_precseti - procedure, pass(prec) :: precsetr => d_bjac_precsetr - procedure, pass(prec) :: precsetc => d_bjac_precsetc - procedure, pass(prec) :: precfree => d_bjac_precfree - procedure, pass(prec) :: precdescr => d_bjac_precdescr - procedure, pass(prec) :: sizeof => d_bjac_sizeof + procedure, pass(prec) :: apply => psb_d_bjac_apply + procedure, pass(prec) :: precbld => psb_d_bjac_precbld + procedure, pass(prec) :: precinit => psb_d_bjac_precinit + procedure, pass(prec) :: precseti => psb_d_bjac_precseti + procedure, pass(prec) :: precsetr => psb_d_bjac_precsetr + procedure, pass(prec) :: precsetc => psb_d_bjac_precsetc + procedure, pass(prec) :: precfree => psb_d_bjac_precfree + procedure, pass(prec) :: precdescr => psb_d_bjac_precdescr + procedure, pass(prec) :: sizeof => psb_d_bjac_sizeof end type psb_d_bjac_prec_type + private :: psb_d_bjac_apply, psb_d_bjac_precbld, psb_d_bjac_precseti,& + & psb_d_bjac_precsetr, psb_d_bjac_precsetc, psb_d_bjac_sizeof,& + & psb_d_bjac_precinit, psb_d_bjac_precfree, psb_d_bjac_precdescr + character(len=15), parameter, private :: & & fact_names(0:2)=(/'None ','ILU(n) ',& @@ -26,7 +30,7 @@ module psb_d_bjacprec contains - subroutine d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_d_bjac_prec_type), intent(in) :: prec @@ -164,9 +168,9 @@ contains return - end subroutine d_bjac_apply + end subroutine psb_d_bjac_apply - subroutine d_bjac_precinit(prec,info) + subroutine psb_d_bjac_precinit(prec,info) use psb_sparse_mod Implicit None @@ -202,10 +206,10 @@ contains return end if return - end subroutine d_bjac_precinit + end subroutine psb_d_bjac_precinit - subroutine d_bjac_precbld(a,desc_a,prec,info,upd) + subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod use psb_prec_mod @@ -346,9 +350,9 @@ contains end if return - end subroutine d_bjac_precbld + end subroutine psb_d_bjac_precbld - subroutine d_bjac_precseti(prec,what,val,info) + subroutine psb_d_bjac_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -401,9 +405,9 @@ contains return end if return - end subroutine d_bjac_precseti + end subroutine psb_d_bjac_precseti - subroutine d_bjac_precsetr(prec,what,val,info) + subroutine psb_d_bjac_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -429,9 +433,9 @@ contains return end if return - end subroutine d_bjac_precsetr + end subroutine psb_d_bjac_precsetr - subroutine d_bjac_precsetc(prec,what,val,info) + subroutine psb_d_bjac_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -457,9 +461,9 @@ contains return end if return - end subroutine d_bjac_precsetc + end subroutine psb_d_bjac_precsetc - subroutine d_bjac_precfree(prec,info) + subroutine psb_d_bjac_precfree(prec,info) use psb_sparse_mod Implicit None @@ -493,10 +497,10 @@ contains end if return - end subroutine d_bjac_precfree + end subroutine psb_d_bjac_precfree - subroutine d_bjac_precdescr(prec,iout) + subroutine psb_d_bjac_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -542,9 +546,9 @@ contains end if return - end subroutine d_bjac_precdescr + end subroutine psb_d_bjac_precdescr - function d_bjac_sizeof(prec) result(val) + function psb_d_bjac_sizeof(prec) result(val) use psb_sparse_mod class(psb_d_bjac_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -558,6 +562,6 @@ contains val = val + psb_sizeof(prec%av(psb_u_pr_)) endif return - end function d_bjac_sizeof + end function psb_d_bjac_sizeof end module psb_d_bjacprec diff --git a/prec/psb_d_diagprec.f03 b/prec/psb_d_diagprec.f03 index 06ba5690..8d905ca1 100644 --- a/prec/psb_d_diagprec.f03 +++ b/prec/psb_d_diagprec.f03 @@ -1,26 +1,30 @@ module psb_d_diagprec - use psb_prec_type + use psb_d_base_prec_mod type, extends(psb_d_base_prec_type) :: psb_d_diag_prec_type real(psb_dpk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => d_diag_apply - procedure, pass(prec) :: precbld => d_diag_precbld - procedure, pass(prec) :: precinit => d_diag_precinit - procedure, pass(prec) :: precseti => d_diag_precseti - procedure, pass(prec) :: precsetr => d_diag_precsetr - procedure, pass(prec) :: precsetc => d_diag_precsetc - procedure, pass(prec) :: precfree => d_diag_precfree - procedure, pass(prec) :: precdescr => d_diag_precdescr - procedure, pass(prec) :: sizeof => d_diag_sizeof + procedure, pass(prec) :: apply => psb_d_diag_apply + procedure, pass(prec) :: precbld => psb_d_diag_precbld + procedure, pass(prec) :: precinit => psb_d_diag_precinit + procedure, pass(prec) :: precseti => psb_d_diag_precseti + procedure, pass(prec) :: precsetr => psb_d_diag_precsetr + procedure, pass(prec) :: precsetc => psb_d_diag_precsetc + procedure, pass(prec) :: precfree => psb_d_diag_precfree + procedure, pass(prec) :: precdescr => psb_d_diag_precdescr + procedure, pass(prec) :: sizeof => psb_d_diag_sizeof end type psb_d_diag_prec_type + private :: psb_d_diag_apply, psb_d_diag_precbld, psb_d_diag_precseti,& + & psb_d_diag_precsetr, psb_d_diag_precsetc, psb_d_diag_sizeof,& + & psb_d_diag_precinit, psb_d_diag_precfree, psb_d_diag_precdescr + contains - subroutine d_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_d_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_d_diag_prec_type), intent(in) :: prec @@ -96,9 +100,9 @@ contains end if return - end subroutine d_diag_apply + end subroutine psb_d_diag_apply - subroutine d_diag_precinit(prec,info) + subroutine psb_d_diag_precinit(prec,info) use psb_sparse_mod Implicit None @@ -123,10 +127,10 @@ contains return end if return - end subroutine d_diag_precinit + end subroutine psb_d_diag_precinit - subroutine d_diag_precbld(a,desc_a,prec,info,upd) + subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -182,9 +186,9 @@ contains return end if return - end subroutine d_diag_precbld + end subroutine psb_d_diag_precbld - subroutine d_diag_precseti(prec,what,val,info) + subroutine psb_d_diag_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -210,9 +214,9 @@ contains return end if return - end subroutine d_diag_precseti + end subroutine psb_d_diag_precseti - subroutine d_diag_precsetr(prec,what,val,info) + subroutine psb_d_diag_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -238,9 +242,9 @@ contains return end if return - end subroutine d_diag_precsetr + end subroutine psb_d_diag_precsetr - subroutine d_diag_precsetc(prec,what,val,info) + subroutine psb_d_diag_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -266,9 +270,9 @@ contains return end if return - end subroutine d_diag_precsetc + end subroutine psb_d_diag_precsetc - subroutine d_diag_precfree(prec,info) + subroutine psb_d_diag_precfree(prec,info) use psb_sparse_mod Implicit None @@ -294,10 +298,10 @@ contains end if return - end subroutine d_diag_precfree + end subroutine psb_d_diag_precfree - subroutine d_diag_precdescr(prec,iout) + subroutine psb_d_diag_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -337,9 +341,9 @@ contains end if return - end subroutine d_diag_precdescr + end subroutine psb_d_diag_precdescr - function d_diag_sizeof(prec) result(val) + function psb_d_diag_sizeof(prec) result(val) use psb_sparse_mod class(psb_d_diag_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -347,6 +351,6 @@ contains val = 0 val = val + psb_sizeof_dp * size(prec%d) return - end function d_diag_sizeof + end function psb_d_diag_sizeof end module psb_d_diagprec diff --git a/prec/psb_d_nullprec.f03 b/prec/psb_d_nullprec.f03 index 1820cdbb..6efee9dc 100644 --- a/prec/psb_d_nullprec.f03 +++ b/prec/psb_d_nullprec.f03 @@ -1,25 +1,28 @@ module psb_d_nullprec - use psb_prec_type + use psb_d_base_prec_mod type, extends(psb_d_base_prec_type) :: psb_d_null_prec_type contains - procedure, pass(prec) :: apply => d_null_apply - procedure, pass(prec) :: precbld => d_null_precbld - procedure, pass(prec) :: precinit => d_null_precinit - procedure, pass(prec) :: precseti => d_null_precseti - procedure, pass(prec) :: precsetr => d_null_precsetr - procedure, pass(prec) :: precsetc => d_null_precsetc - procedure, pass(prec) :: precfree => d_null_precfree - procedure, pass(prec) :: precdescr => d_null_precdescr - procedure, pass(prec) :: sizeof => d_null_sizeof + procedure, pass(prec) :: apply => psb_d_null_apply + procedure, pass(prec) :: precbld => psb_d_null_precbld + procedure, pass(prec) :: precinit => psb_d_null_precinit + procedure, pass(prec) :: precseti => psb_d_null_precseti + procedure, pass(prec) :: precsetr => psb_d_null_precsetr + procedure, pass(prec) :: precsetc => psb_d_null_precsetc + procedure, pass(prec) :: precfree => psb_d_null_precfree + procedure, pass(prec) :: precdescr => psb_d_null_precdescr + procedure, pass(prec) :: sizeof => psb_d_null_sizeof end type psb_d_null_prec_type - + private :: psb_d_null_apply, psb_d_null_precbld, psb_d_null_precseti,& + & psb_d_null_precsetr, psb_d_null_precsetc, psb_d_null_sizeof,& + & psb_d_null_precinit, psb_d_null_precfree, psb_d_null_precdescr + contains - subroutine d_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_d_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_d_null_prec_type), intent(in) :: prec @@ -70,10 +73,10 @@ contains end if return - end subroutine d_null_apply + end subroutine psb_d_null_apply - subroutine d_null_precinit(prec,info) + subroutine psb_d_null_precinit(prec,info) use psb_sparse_mod Implicit None @@ -98,9 +101,9 @@ contains return end if return - end subroutine d_null_precinit + end subroutine psb_d_null_precinit - subroutine d_null_precbld(a,desc_a,prec,info,upd) + subroutine psb_d_null_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -128,9 +131,9 @@ contains return end if return - end subroutine d_null_precbld + end subroutine psb_d_null_precbld - subroutine d_null_precseti(prec,what,val,info) + subroutine psb_d_null_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -156,9 +159,9 @@ contains return end if return - end subroutine d_null_precseti + end subroutine psb_d_null_precseti - subroutine d_null_precsetr(prec,what,val,info) + subroutine psb_d_null_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -184,9 +187,9 @@ contains return end if return - end subroutine d_null_precsetr + end subroutine psb_d_null_precsetr - subroutine d_null_precsetc(prec,what,val,info) + subroutine psb_d_null_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -212,9 +215,9 @@ contains return end if return - end subroutine d_null_precsetc + end subroutine psb_d_null_precsetc - subroutine d_null_precfree(prec,info) + subroutine psb_d_null_precfree(prec,info) use psb_sparse_mod Implicit None @@ -240,10 +243,10 @@ contains end if return - end subroutine d_null_precfree + end subroutine psb_d_null_precfree - subroutine d_null_precdescr(prec,iout) + subroutine psb_d_null_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -278,9 +281,9 @@ contains end if return - end subroutine d_null_precdescr + end subroutine psb_d_null_precdescr - function d_null_sizeof(prec) result(val) + function psb_d_null_sizeof(prec) result(val) use psb_sparse_mod class(psb_d_null_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -288,6 +291,6 @@ contains val = 0 return - end function d_null_sizeof + end function psb_d_null_sizeof end module psb_d_nullprec diff --git a/prec/psb_d_prec_type.f03 b/prec/psb_d_prec_type.f03 index 5d7d972c..4b4577c9 100644 --- a/prec/psb_d_prec_type.f03 +++ b/prec/psb_d_prec_type.f03 @@ -43,20 +43,7 @@ module psb_d_prec_type use psb_prec_const_mod - - type psb_d_base_prec_type - contains - procedure, pass(prec) :: apply => d_base_apply - procedure, pass(prec) :: precbld => d_base_precbld - procedure, pass(prec) :: precseti => d_base_precseti - procedure, pass(prec) :: precsetr => d_base_precsetr - procedure, pass(prec) :: precsetc => d_base_precsetc - procedure, pass(prec) :: sizeof => d_base_sizeof - generic, public :: precset => precseti, precsetr, precsetc - procedure, pass(prec) :: precinit => d_base_precinit - procedure, pass(prec) :: precfree => d_base_precfree - procedure, pass(prec) :: precdescr => d_base_precdescr - end type psb_d_base_prec_type + use psb_d_base_prec_mod type psb_dprec_type class(psb_d_base_prec_type), allocatable :: prec @@ -313,288 +300,4 @@ contains end subroutine d_apply1v - subroutine d_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) - use psb_sparse_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_d_base_prec_type), intent(in) :: prec - real(psb_dpk_),intent(in) :: alpha, beta - real(psb_dpk_),intent(in) :: x(:) - real(psb_dpk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans - real(psb_dpk_),intent(inout), optional, target :: work(:) - Integer :: err_act, nrow - character(len=20) :: name='d_base_prec_apply' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine d_base_apply - - subroutine d_base_precinit(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_d_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='d_base_precinit' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_base_precinit - - subroutine d_base_precbld(a,desc_a,prec,info,upd) - - use psb_sparse_mod - Implicit None - - type(psb_d_sparse_mat), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - class(psb_d_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - character, intent(in), optional :: upd - Integer :: err_act, nrow - character(len=20) :: name='d_base_precbld' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_base_precbld - - subroutine d_base_precseti(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_d_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - integer, intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='d_base_precseti' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_base_precseti - - subroutine d_base_precsetr(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_d_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='d_base_precsetr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_base_precsetr - - subroutine d_base_precsetc(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_d_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='d_base_precsetc' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_base_precsetc - - subroutine d_base_precfree(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_d_base_prec_type), intent(inout) :: prec - integer, intent(out) :: info - - Integer :: err_act, nrow - character(len=20) :: name='d_base_precfree' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine d_base_precfree - - - subroutine d_base_precdescr(prec,iout) - - use psb_sparse_mod - Implicit None - - class(psb_d_base_prec_type), intent(in) :: prec - integer, intent(in), optional :: iout - - Integer :: err_act, nrow, info - character(len=20) :: name='d_base_precdescr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine d_base_precdescr - - - function d_base_sizeof(prec) result(val) - use psb_sparse_mod - class(psb_d_base_prec_type), intent(in) :: prec - integer(psb_long_int_k_) :: val - - val = 0 - return - end function d_base_sizeof - end module psb_d_prec_type diff --git a/prec/psb_s_base_prec_mod.f03 b/prec/psb_s_base_prec_mod.f03 new file mode 100644 index 00000000..ab9f6bef --- /dev/null +++ b/prec/psb_s_base_prec_mod.f03 @@ -0,0 +1,352 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS 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 +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Module to define PREC_DATA, !! +!! structure for preconditioning. !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +module psb_s_base_prec_mod + + ! Reduces size of .mod file. + use psb_sparse_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& + & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& + & psb_s_sparse_mat + + use psb_prec_const_mod + + type psb_s_base_prec_type + contains + procedure, pass(prec) :: apply => psb_s_base_apply + procedure, pass(prec) :: precbld => psb_s_base_precbld + procedure, pass(prec) :: precseti => psb_s_base_precseti + procedure, pass(prec) :: precsetr => psb_s_base_precsetr + procedure, pass(prec) :: precsetc => psb_s_base_precsetc + procedure, pass(prec) :: sizeof => psb_s_base_sizeof + generic, public :: precset => precseti, precsetr, precsetc + procedure, pass(prec) :: precinit => psb_s_base_precinit + procedure, pass(prec) :: precfree => psb_s_base_precfree + procedure, pass(prec) :: precdescr => psb_s_base_precdescr + end type psb_s_base_prec_type + + private :: psb_s_base_apply, psb_s_base_precbld, psb_s_base_precseti,& + & psb_s_base_precsetr, psb_s_base_precsetc, psb_s_base_sizeof,& + & psb_s_base_precinit, psb_s_base_precfree, psb_s_base_precdescr + +contains + + + subroutine psb_s_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_sparse_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_s_base_prec_type), intent(in) :: prec + real(psb_spk_),intent(in) :: alpha, beta + real(psb_spk_),intent(in) :: x(:) + real(psb_spk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='s_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_s_base_apply + + subroutine psb_s_base_precinit(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_s_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='s_base_precinit' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_s_base_precinit + + subroutine psb_s_base_precbld(a,desc_a,prec,info,upd) + + use psb_sparse_mod + Implicit None + + type(psb_s_sparse_mat), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + class(psb_s_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + character, intent(in), optional :: upd + Integer :: err_act, nrow + character(len=20) :: name='s_base_precbld' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_s_base_precbld + + subroutine psb_s_base_precseti(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_s_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + integer, intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='s_base_precseti' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_s_base_precseti + + subroutine psb_s_base_precsetr(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_s_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + real(psb_spk_), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='s_base_precsetr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_s_base_precsetr + + subroutine psb_s_base_precsetc(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_s_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + character(len=*), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='s_base_precsetc' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_s_base_precsetc + + subroutine psb_s_base_precfree(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_s_base_prec_type), intent(inout) :: prec + integer, intent(out) :: info + + Integer :: err_act, nrow + character(len=20) :: name='s_base_precfree' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_s_base_precfree + + + subroutine psb_s_base_precdescr(prec,iout) + + use psb_sparse_mod + Implicit None + + class(psb_s_base_prec_type), intent(in) :: prec + integer, intent(in), optional :: iout + + Integer :: err_act, nrow, info + character(len=20) :: name='s_base_precdescr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_s_base_precdescr + + + function psb_s_base_sizeof(prec) result(val) + use psb_sparse_mod + class(psb_s_base_prec_type), intent(in) :: prec + integer(psb_long_int_k_) :: val + + val = 0 + return + end function psb_s_base_sizeof + + +end module psb_s_base_prec_mod diff --git a/prec/psb_s_bjacprec.f03 b/prec/psb_s_bjacprec.f03 index 57093fe6..5a017e40 100644 --- a/prec/psb_s_bjacprec.f03 +++ b/prec/psb_s_bjacprec.f03 @@ -1,23 +1,27 @@ module psb_s_bjacprec - use psb_prec_type + use psb_s_base_prec_mod type, extends(psb_s_base_prec_type) :: psb_s_bjac_prec_type integer, allocatable :: iprcparm(:) type(psb_s_sparse_mat), allocatable :: av(:) real(psb_spk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => s_bjac_apply - procedure, pass(prec) :: precbld => s_bjac_precbld - procedure, pass(prec) :: precinit => s_bjac_precinit - procedure, pass(prec) :: precseti => s_bjac_precseti - procedure, pass(prec) :: precsetr => s_bjac_precsetr - procedure, pass(prec) :: precsetc => s_bjac_precsetc - procedure, pass(prec) :: precfree => s_bjac_precfree - procedure, pass(prec) :: precdescr => s_bjac_precdescr - procedure, pass(prec) :: sizeof => s_bjac_sizeof + procedure, pass(prec) :: apply => psb_s_bjac_apply + procedure, pass(prec) :: precbld => psb_s_bjac_precbld + procedure, pass(prec) :: precinit => psb_s_bjac_precinit + procedure, pass(prec) :: precseti => psb_s_bjac_precseti + procedure, pass(prec) :: precsetr => psb_s_bjac_precsetr + procedure, pass(prec) :: precsetc => psb_s_bjac_precsetc + procedure, pass(prec) :: precfree => psb_s_bjac_precfree + procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr + procedure, pass(prec) :: sizeof => psb_s_bjac_sizeof end type psb_s_bjac_prec_type + private :: psb_s_bjac_apply, psb_s_bjac_precbld, psb_s_bjac_precseti,& + & psb_s_bjac_precsetr, psb_s_bjac_precsetc, psb_s_bjac_sizeof,& + & psb_s_bjac_precinit, psb_s_bjac_precfree, psb_s_bjac_precdescr + character(len=15), parameter, private :: & & fact_names(0:2)=(/'None ','ILU(n) ',& @@ -26,7 +30,7 @@ module psb_s_bjacprec contains - subroutine s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_s_bjac_prec_type), intent(in) :: prec @@ -164,9 +168,9 @@ contains return - end subroutine s_bjac_apply + end subroutine psb_s_bjac_apply - subroutine s_bjac_precinit(prec,info) + subroutine psb_s_bjac_precinit(prec,info) use psb_sparse_mod Implicit None @@ -202,10 +206,10 @@ contains return end if return - end subroutine s_bjac_precinit + end subroutine psb_s_bjac_precinit - subroutine s_bjac_precbld(a,desc_a,prec,info,upd) + subroutine psb_s_bjac_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod use psb_prec_mod @@ -346,9 +350,9 @@ contains end if return - end subroutine s_bjac_precbld + end subroutine psb_s_bjac_precbld - subroutine s_bjac_precseti(prec,what,val,info) + subroutine psb_s_bjac_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -401,9 +405,9 @@ contains return end if return - end subroutine s_bjac_precseti + end subroutine psb_s_bjac_precseti - subroutine s_bjac_precsetr(prec,what,val,info) + subroutine psb_s_bjac_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -429,9 +433,9 @@ contains return end if return - end subroutine s_bjac_precsetr + end subroutine psb_s_bjac_precsetr - subroutine s_bjac_precsetc(prec,what,val,info) + subroutine psb_s_bjac_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -457,9 +461,9 @@ contains return end if return - end subroutine s_bjac_precsetc + end subroutine psb_s_bjac_precsetc - subroutine s_bjac_precfree(prec,info) + subroutine psb_s_bjac_precfree(prec,info) use psb_sparse_mod Implicit None @@ -493,10 +497,10 @@ contains end if return - end subroutine s_bjac_precfree + end subroutine psb_s_bjac_precfree - subroutine s_bjac_precdescr(prec,iout) + subroutine psb_s_bjac_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -542,9 +546,9 @@ contains end if return - end subroutine s_bjac_precdescr + end subroutine psb_s_bjac_precdescr - function s_bjac_sizeof(prec) result(val) + function psb_s_bjac_sizeof(prec) result(val) use psb_sparse_mod class(psb_s_bjac_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -558,6 +562,6 @@ contains val = val + psb_sizeof(prec%av(psb_u_pr_)) endif return - end function s_bjac_sizeof + end function psb_s_bjac_sizeof end module psb_s_bjacprec diff --git a/prec/psb_s_diagprec.f03 b/prec/psb_s_diagprec.f03 index bd3f6ee1..4c289f84 100644 --- a/prec/psb_s_diagprec.f03 +++ b/prec/psb_s_diagprec.f03 @@ -1,26 +1,30 @@ module psb_s_diagprec - use psb_prec_type + use psb_s_base_prec_mod type, extends(psb_s_base_prec_type) :: psb_s_diag_prec_type real(psb_spk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => s_diag_apply - procedure, pass(prec) :: precbld => s_diag_precbld - procedure, pass(prec) :: precinit => s_diag_precinit - procedure, pass(prec) :: precseti => s_diag_precseti - procedure, pass(prec) :: precsetr => s_diag_precsetr - procedure, pass(prec) :: precsetc => s_diag_precsetc - procedure, pass(prec) :: precfree => s_diag_precfree - procedure, pass(prec) :: precdescr => s_diag_precdescr - procedure, pass(prec) :: sizeof => s_diag_sizeof + procedure, pass(prec) :: apply => psb_s_diag_apply + procedure, pass(prec) :: precbld => psb_s_diag_precbld + procedure, pass(prec) :: precinit => psb_s_diag_precinit + procedure, pass(prec) :: precseti => psb_s_diag_precseti + procedure, pass(prec) :: precsetr => psb_s_diag_precsetr + procedure, pass(prec) :: precsetc => psb_s_diag_precsetc + procedure, pass(prec) :: precfree => psb_s_diag_precfree + procedure, pass(prec) :: precdescr => psb_s_diag_precdescr + procedure, pass(prec) :: sizeof => psb_s_diag_sizeof end type psb_s_diag_prec_type + private :: psb_s_diag_apply, psb_s_diag_precbld, psb_s_diag_precseti,& + & psb_s_diag_precsetr, psb_s_diag_precsetc, psb_s_diag_sizeof,& + & psb_s_diag_precinit, psb_s_diag_precfree, psb_s_diag_precdescr + contains - subroutine s_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_s_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_s_diag_prec_type), intent(in) :: prec @@ -96,9 +100,9 @@ contains end if return - end subroutine s_diag_apply + end subroutine psb_s_diag_apply - subroutine s_diag_precinit(prec,info) + subroutine psb_s_diag_precinit(prec,info) use psb_sparse_mod Implicit None @@ -123,10 +127,10 @@ contains return end if return - end subroutine s_diag_precinit + end subroutine psb_s_diag_precinit - subroutine s_diag_precbld(a,desc_a,prec,info,upd) + subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -182,9 +186,9 @@ contains return end if return - end subroutine s_diag_precbld + end subroutine psb_s_diag_precbld - subroutine s_diag_precseti(prec,what,val,info) + subroutine psb_s_diag_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -210,9 +214,9 @@ contains return end if return - end subroutine s_diag_precseti + end subroutine psb_s_diag_precseti - subroutine s_diag_precsetr(prec,what,val,info) + subroutine psb_s_diag_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -238,9 +242,9 @@ contains return end if return - end subroutine s_diag_precsetr + end subroutine psb_s_diag_precsetr - subroutine s_diag_precsetc(prec,what,val,info) + subroutine psb_s_diag_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -266,9 +270,9 @@ contains return end if return - end subroutine s_diag_precsetc + end subroutine psb_s_diag_precsetc - subroutine s_diag_precfree(prec,info) + subroutine psb_s_diag_precfree(prec,info) use psb_sparse_mod Implicit None @@ -294,10 +298,10 @@ contains end if return - end subroutine s_diag_precfree + end subroutine psb_s_diag_precfree - subroutine s_diag_precdescr(prec,iout) + subroutine psb_s_diag_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -337,9 +341,9 @@ contains end if return - end subroutine s_diag_precdescr + end subroutine psb_s_diag_precdescr - function s_diag_sizeof(prec) result(val) + function psb_s_diag_sizeof(prec) result(val) use psb_sparse_mod class(psb_s_diag_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -347,6 +351,6 @@ contains val = 0 val = val + psb_sizeof_sp * size(prec%d) return - end function s_diag_sizeof + end function psb_s_diag_sizeof end module psb_s_diagprec diff --git a/prec/psb_s_nullprec.f03 b/prec/psb_s_nullprec.f03 index cab73b49..591962a2 100644 --- a/prec/psb_s_nullprec.f03 +++ b/prec/psb_s_nullprec.f03 @@ -1,25 +1,28 @@ module psb_s_nullprec - use psb_prec_type + use psb_s_base_prec_mod type, extends(psb_s_base_prec_type) :: psb_s_null_prec_type contains - procedure, pass(prec) :: apply => s_null_apply - procedure, pass(prec) :: precbld => s_null_precbld - procedure, pass(prec) :: precinit => s_null_precinit - procedure, pass(prec) :: precseti => s_null_precseti - procedure, pass(prec) :: precsetr => s_null_precsetr - procedure, pass(prec) :: precsetc => s_null_precsetc - procedure, pass(prec) :: precfree => s_null_precfree - procedure, pass(prec) :: precdescr => s_null_precdescr - procedure, pass(prec) :: sizeof => s_null_sizeof + procedure, pass(prec) :: apply => psb_s_null_apply + procedure, pass(prec) :: precbld => psb_s_null_precbld + procedure, pass(prec) :: precinit => psb_s_null_precinit + procedure, pass(prec) :: precseti => psb_s_null_precseti + procedure, pass(prec) :: precsetr => psb_s_null_precsetr + procedure, pass(prec) :: precsetc => psb_s_null_precsetc + procedure, pass(prec) :: precfree => psb_s_null_precfree + procedure, pass(prec) :: precdescr => psb_s_null_precdescr + procedure, pass(prec) :: sizeof => psb_s_null_sizeof end type psb_s_null_prec_type - + private :: psb_s_null_apply, psb_s_null_precbld, psb_s_null_precseti,& + & psb_s_null_precsetr, psb_s_null_precsetc, psb_s_null_sizeof,& + & psb_s_null_precinit, psb_s_null_precfree, psb_s_null_precdescr + contains - subroutine s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_s_null_prec_type), intent(in) :: prec @@ -35,7 +38,6 @@ contains call psb_erractionsave(err_act) ! - ! This is the base version and we should throw an error. ! Or should it be the NULL preonditioner??? ! info = psb_success_ @@ -70,10 +72,10 @@ contains end if return - end subroutine s_null_apply + end subroutine psb_s_null_apply - subroutine s_null_precinit(prec,info) + subroutine psb_s_null_precinit(prec,info) use psb_sparse_mod Implicit None @@ -98,9 +100,9 @@ contains return end if return - end subroutine s_null_precinit + end subroutine psb_s_null_precinit - subroutine s_null_precbld(a,desc_a,prec,info,upd) + subroutine psb_s_null_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -128,9 +130,9 @@ contains return end if return - end subroutine s_null_precbld + end subroutine psb_s_null_precbld - subroutine s_null_precseti(prec,what,val,info) + subroutine psb_s_null_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -156,9 +158,9 @@ contains return end if return - end subroutine s_null_precseti + end subroutine psb_s_null_precseti - subroutine s_null_precsetr(prec,what,val,info) + subroutine psb_s_null_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -184,9 +186,9 @@ contains return end if return - end subroutine s_null_precsetr + end subroutine psb_s_null_precsetr - subroutine s_null_precsetc(prec,what,val,info) + subroutine psb_s_null_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -212,9 +214,9 @@ contains return end if return - end subroutine s_null_precsetc + end subroutine psb_s_null_precsetc - subroutine s_null_precfree(prec,info) + subroutine psb_s_null_precfree(prec,info) use psb_sparse_mod Implicit None @@ -240,10 +242,10 @@ contains end if return - end subroutine s_null_precfree + end subroutine psb_s_null_precfree - subroutine s_null_precdescr(prec,iout) + subroutine psb_s_null_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -278,9 +280,9 @@ contains end if return - end subroutine s_null_precdescr + end subroutine psb_s_null_precdescr - function s_null_sizeof(prec) result(val) + function psb_s_null_sizeof(prec) result(val) use psb_sparse_mod class(psb_s_null_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -288,6 +290,6 @@ contains val = 0 return - end function s_null_sizeof + end function psb_s_null_sizeof end module psb_s_nullprec diff --git a/prec/psb_s_prec_type.f03 b/prec/psb_s_prec_type.f03 index c2dfd46c..ff8a1d96 100644 --- a/prec/psb_s_prec_type.f03 +++ b/prec/psb_s_prec_type.f03 @@ -42,22 +42,8 @@ module psb_s_prec_type & psb_s_sparse_mat use psb_prec_const_mod + use psb_s_base_prec_mod - - type psb_s_base_prec_type - contains - procedure, pass(prec) :: apply => s_base_apply - procedure, pass(prec) :: precbld => s_base_precbld - procedure, pass(prec) :: precseti => s_base_precseti - procedure, pass(prec) :: precsetr => s_base_precsetr - procedure, pass(prec) :: precsetc => s_base_precsetc - procedure, pass(prec) :: sizeof => s_base_sizeof - generic, public :: precset => precseti, precsetr, precsetc - procedure, pass(prec) :: precinit => s_base_precinit - procedure, pass(prec) :: precfree => s_base_precfree - procedure, pass(prec) :: precdescr => s_base_precdescr - end type psb_s_base_prec_type - type psb_sprec_type class(psb_s_base_prec_type), allocatable :: prec contains @@ -83,8 +69,6 @@ module psb_s_prec_type module procedure psb_sprec_sizeof end interface - - interface psb_precaply subroutine psb_sprc_aply(prec,x,y,desc_data,info,trans,work) use psb_sparse_mod, only : psb_desc_type, psb_spk_ @@ -315,291 +299,4 @@ contains end subroutine s_apply1v - - - subroutine s_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) - use psb_sparse_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_s_base_prec_type), intent(in) :: prec - real(psb_spk_),intent(in) :: alpha, beta - real(psb_spk_),intent(in) :: x(:) - real(psb_spk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans - real(psb_spk_),intent(inout), optional, target :: work(:) - Integer :: err_act, nrow - character(len=20) :: name='s_base_prec_apply' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine s_base_apply - - subroutine s_base_precinit(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_s_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='s_base_precinit' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_base_precinit - - subroutine s_base_precbld(a,desc_a,prec,info,upd) - - use psb_sparse_mod - Implicit None - - type(psb_s_sparse_mat), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - class(psb_s_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - character, intent(in), optional :: upd - Integer :: err_act, nrow - character(len=20) :: name='s_base_precbld' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_base_precbld - - subroutine s_base_precseti(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_s_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - integer, intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='s_base_precseti' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_base_precseti - - subroutine s_base_precsetr(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_s_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - real(psb_spk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='s_base_precsetr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_base_precsetr - - subroutine s_base_precsetc(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_s_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='s_base_precsetc' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_base_precsetc - - subroutine s_base_precfree(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_s_base_prec_type), intent(inout) :: prec - integer, intent(out) :: info - - Integer :: err_act, nrow - character(len=20) :: name='s_base_precfree' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine s_base_precfree - - - subroutine s_base_precdescr(prec,iout) - - use psb_sparse_mod - Implicit None - - class(psb_s_base_prec_type), intent(in) :: prec - integer, intent(in), optional :: iout - - Integer :: err_act, nrow, info - character(len=20) :: name='s_base_precdescr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine s_base_precdescr - - - function s_base_sizeof(prec) result(val) - use psb_sparse_mod - class(psb_s_base_prec_type), intent(in) :: prec - integer(psb_long_int_k_) :: val - - val = 0 - return - end function s_base_sizeof - - end module psb_s_prec_type diff --git a/prec/psb_z_base_prec_mod.f03 b/prec/psb_z_base_prec_mod.f03 new file mode 100644 index 00000000..c6deb051 --- /dev/null +++ b/prec/psb_z_base_prec_mod.f03 @@ -0,0 +1,352 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS 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 +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ 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. +!!$ +!!$ +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Module to define PREC_DATA, !! +!! structure for preconditioning. !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +module psb_z_base_prec_mod + + ! Reduces size of .mod file. + use psb_sparse_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& + & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& + & psb_z_sparse_mat + + use psb_prec_const_mod + + type psb_z_base_prec_type + contains + procedure, pass(prec) :: apply => psb_z_base_apply + procedure, pass(prec) :: precbld => psb_z_base_precbld + procedure, pass(prec) :: precseti => psb_z_base_precseti + procedure, pass(prec) :: precsetr => psb_z_base_precsetr + procedure, pass(prec) :: precsetc => psb_z_base_precsetc + procedure, pass(prec) :: sizeof => psb_z_base_sizeof + generic, public :: precset => precseti, precsetr, precsetc + procedure, pass(prec) :: precinit => psb_z_base_precinit + procedure, pass(prec) :: precfree => psb_z_base_precfree + procedure, pass(prec) :: precdescr => psb_z_base_precdescr + end type psb_z_base_prec_type + + private :: psb_z_base_apply, psb_z_base_precbld, psb_z_base_precseti,& + & psb_z_base_precsetr, psb_z_base_precsetc, psb_z_base_sizeof,& + & psb_z_base_precinit, psb_z_base_precfree, psb_z_base_precdescr + + +contains + + + subroutine psb_z_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_sparse_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_z_base_prec_type), intent(in) :: prec + complex(psb_dpk_),intent(in) :: alpha, beta + complex(psb_dpk_),intent(in) :: x(:) + complex(psb_dpk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='z_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_z_base_apply + + subroutine psb_z_base_precinit(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_z_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='z_base_precinit' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_z_base_precinit + + subroutine psb_z_base_precbld(a,desc_a,prec,info,upd) + + use psb_sparse_mod + Implicit None + + type(psb_z_sparse_mat), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + class(psb_z_base_prec_type),intent(inout) :: prec + integer, intent(out) :: info + character, intent(in), optional :: upd + Integer :: err_act, nrow + character(len=20) :: name='z_base_precbld' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_z_base_precbld + + subroutine psb_z_base_precseti(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_z_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + integer, intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='z_base_precseti' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_z_base_precseti + + subroutine psb_z_base_precsetr(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_z_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='z_base_precsetr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_z_base_precsetr + + subroutine psb_z_base_precsetc(prec,what,val,info) + + use psb_sparse_mod + Implicit None + + class(psb_z_base_prec_type),intent(inout) :: prec + integer, intent(in) :: what + character(len=*), intent(in) :: val + integer, intent(out) :: info + Integer :: err_act, nrow + character(len=20) :: name='z_base_precsetc' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine psb_z_base_precsetc + + subroutine psb_z_base_precfree(prec,info) + + use psb_sparse_mod + Implicit None + + class(psb_z_base_prec_type), intent(inout) :: prec + integer, intent(out) :: info + + Integer :: err_act, nrow + character(len=20) :: name='z_base_precfree' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_z_base_precfree + + + subroutine psb_z_base_precdescr(prec,iout) + + use psb_sparse_mod + Implicit None + + class(psb_z_base_prec_type), intent(in) :: prec + integer, intent(in), optional :: iout + + Integer :: err_act, nrow, info + character(len=20) :: name='z_base_precdescr' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine psb_z_base_precdescr + + + function psb_z_base_sizeof(prec) result(val) + use psb_sparse_mod + class(psb_z_base_prec_type), intent(in) :: prec + integer(psb_long_int_k_) :: val + + val = 0 + return + end function psb_z_base_sizeof + +end module psb_z_base_prec_mod diff --git a/prec/psb_z_bjacprec.f03 b/prec/psb_z_bjacprec.f03 index 79e6c047..97c09edd 100644 --- a/prec/psb_z_bjacprec.f03 +++ b/prec/psb_z_bjacprec.f03 @@ -1,23 +1,27 @@ module psb_z_bjacprec - use psb_prec_type + use psb_z_base_prec_mod type, extends(psb_z_base_prec_type) :: psb_z_bjac_prec_type integer, allocatable :: iprcparm(:) type(psb_z_sparse_mat), allocatable :: av(:) complex(psb_dpk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => z_bjac_apply - procedure, pass(prec) :: precbld => z_bjac_precbld - procedure, pass(prec) :: precinit => z_bjac_precinit - procedure, pass(prec) :: precseti => z_bjac_precseti - procedure, pass(prec) :: precsetr => z_bjac_precsetr - procedure, pass(prec) :: precsetc => z_bjac_precsetc - procedure, pass(prec) :: precfree => z_bjac_precfree - procedure, pass(prec) :: precdescr => z_bjac_precdescr - procedure, pass(prec) :: sizeof => z_bjac_sizeof + procedure, pass(prec) :: apply => psb_z_bjac_apply + procedure, pass(prec) :: precbld => psb_z_bjac_precbld + procedure, pass(prec) :: precinit => psb_z_bjac_precinit + procedure, pass(prec) :: precseti => psb_z_bjac_precseti + procedure, pass(prec) :: precsetr => psb_z_bjac_precsetr + procedure, pass(prec) :: precsetc => psb_z_bjac_precsetc + procedure, pass(prec) :: precfree => psb_z_bjac_precfree + procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr + procedure, pass(prec) :: sizeof => psb_z_bjac_sizeof end type psb_z_bjac_prec_type + private :: psb_z_bjac_apply, psb_z_bjac_precbld, psb_z_bjac_precseti,& + & psb_z_bjac_precsetr, psb_z_bjac_precsetc, psb_z_bjac_sizeof,& + & psb_z_bjac_precinit, psb_z_bjac_precfree, psb_z_bjac_precdescr + character(len=15), parameter, private :: & & fact_names(0:2)=(/'None ','ILU(n) ',& @@ -26,7 +30,7 @@ module psb_z_bjacprec contains - subroutine z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_z_bjac_prec_type), intent(in) :: prec @@ -170,9 +174,9 @@ contains return - end subroutine z_bjac_apply + end subroutine psb_z_bjac_apply - subroutine z_bjac_precinit(prec,info) + subroutine psb_z_bjac_precinit(prec,info) use psb_sparse_mod Implicit None @@ -208,10 +212,10 @@ contains return end if return - end subroutine z_bjac_precinit + end subroutine psb_z_bjac_precinit - subroutine z_bjac_precbld(a,desc_a,prec,info,upd) + subroutine psb_z_bjac_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod use psb_prec_mod @@ -352,9 +356,9 @@ contains end if return - end subroutine z_bjac_precbld + end subroutine psb_z_bjac_precbld - subroutine z_bjac_precseti(prec,what,val,info) + subroutine psb_z_bjac_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -407,9 +411,9 @@ contains return end if return - end subroutine z_bjac_precseti + end subroutine psb_z_bjac_precseti - subroutine z_bjac_precsetr(prec,what,val,info) + subroutine psb_z_bjac_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -435,9 +439,9 @@ contains return end if return - end subroutine z_bjac_precsetr + end subroutine psb_z_bjac_precsetr - subroutine z_bjac_precsetc(prec,what,val,info) + subroutine psb_z_bjac_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -463,9 +467,9 @@ contains return end if return - end subroutine z_bjac_precsetc + end subroutine psb_z_bjac_precsetc - subroutine z_bjac_precfree(prec,info) + subroutine psb_z_bjac_precfree(prec,info) use psb_sparse_mod Implicit None @@ -499,10 +503,10 @@ contains end if return - end subroutine z_bjac_precfree + end subroutine psb_z_bjac_precfree - subroutine z_bjac_precdescr(prec,iout) + subroutine psb_z_bjac_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -548,9 +552,9 @@ contains end if return - end subroutine z_bjac_precdescr + end subroutine psb_z_bjac_precdescr - function z_bjac_sizeof(prec) result(val) + function psb_z_bjac_sizeof(prec) result(val) use psb_sparse_mod class(psb_z_bjac_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -564,6 +568,6 @@ contains val = val + psb_sizeof(prec%av(psb_u_pr_)) endif return - end function z_bjac_sizeof + end function psb_z_bjac_sizeof end module psb_z_bjacprec diff --git a/prec/psb_z_diagprec.f03 b/prec/psb_z_diagprec.f03 index f34108d1..33f04b51 100644 --- a/prec/psb_z_diagprec.f03 +++ b/prec/psb_z_diagprec.f03 @@ -1,26 +1,30 @@ module psb_z_diagprec - use psb_prec_type + use psb_z_base_prec_mod type, extends(psb_z_base_prec_type) :: psb_z_diag_prec_type complex(psb_dpk_), allocatable :: d(:) contains - procedure, pass(prec) :: apply => z_diag_apply - procedure, pass(prec) :: precbld => z_diag_precbld - procedure, pass(prec) :: precinit => z_diag_precinit - procedure, pass(prec) :: precseti => z_diag_precseti - procedure, pass(prec) :: precsetr => z_diag_precsetr - procedure, pass(prec) :: precsetc => z_diag_precsetc - procedure, pass(prec) :: precfree => z_diag_precfree - procedure, pass(prec) :: precdescr => z_diag_precdescr - procedure, pass(prec) :: sizeof => z_diag_sizeof + procedure, pass(prec) :: apply => psb_z_diag_apply + procedure, pass(prec) :: precbld => psb_z_diag_precbld + procedure, pass(prec) :: precinit => psb_z_diag_precinit + procedure, pass(prec) :: precseti => psb_z_diag_precseti + procedure, pass(prec) :: precsetr => psb_z_diag_precsetr + procedure, pass(prec) :: precsetc => psb_z_diag_precsetc + procedure, pass(prec) :: precfree => psb_z_diag_precfree + procedure, pass(prec) :: precdescr => psb_z_diag_precdescr + procedure, pass(prec) :: sizeof => psb_z_diag_sizeof end type psb_z_diag_prec_type + private :: psb_z_diag_apply, psb_z_diag_precbld, psb_z_diag_precseti,& + & psb_z_diag_precsetr, psb_z_diag_precsetc, psb_z_diag_sizeof,& + & psb_z_diag_precinit, psb_z_diag_precfree, psb_z_diag_precdescr + contains - subroutine z_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_z_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_z_diag_prec_type), intent(in) :: prec @@ -119,9 +123,9 @@ contains end if return - end subroutine z_diag_apply + end subroutine psb_z_diag_apply - subroutine z_diag_precinit(prec,info) + subroutine psb_z_diag_precinit(prec,info) use psb_sparse_mod Implicit None @@ -146,10 +150,10 @@ contains return end if return - end subroutine z_diag_precinit + end subroutine psb_z_diag_precinit - subroutine z_diag_precbld(a,desc_a,prec,info,upd) + subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -205,9 +209,9 @@ contains return end if return - end subroutine z_diag_precbld + end subroutine psb_z_diag_precbld - subroutine z_diag_precseti(prec,what,val,info) + subroutine psb_z_diag_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -233,9 +237,9 @@ contains return end if return - end subroutine z_diag_precseti + end subroutine psb_z_diag_precseti - subroutine z_diag_precsetr(prec,what,val,info) + subroutine psb_z_diag_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -261,9 +265,9 @@ contains return end if return - end subroutine z_diag_precsetr + end subroutine psb_z_diag_precsetr - subroutine z_diag_precsetc(prec,what,val,info) + subroutine psb_z_diag_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -289,9 +293,9 @@ contains return end if return - end subroutine z_diag_precsetc + end subroutine psb_z_diag_precsetc - subroutine z_diag_precfree(prec,info) + subroutine psb_z_diag_precfree(prec,info) use psb_sparse_mod Implicit None @@ -317,10 +321,10 @@ contains end if return - end subroutine z_diag_precfree + end subroutine psb_z_diag_precfree - subroutine z_diag_precdescr(prec,iout) + subroutine psb_z_diag_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -360,9 +364,9 @@ contains end if return - end subroutine z_diag_precdescr + end subroutine psb_z_diag_precdescr - function z_diag_sizeof(prec) result(val) + function psb_z_diag_sizeof(prec) result(val) use psb_sparse_mod class(psb_z_diag_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -370,6 +374,6 @@ contains val = 0 val = val + 2*psb_sizeof_dp * size(prec%d) return - end function z_diag_sizeof + end function psb_z_diag_sizeof end module psb_z_diagprec diff --git a/prec/psb_z_nullprec.f03 b/prec/psb_z_nullprec.f03 index 1c78153e..7f2d1ae2 100644 --- a/prec/psb_z_nullprec.f03 +++ b/prec/psb_z_nullprec.f03 @@ -1,25 +1,29 @@ module psb_z_nullprec - use psb_prec_type + use psb_z_base_prec_mod type, extends(psb_z_base_prec_type) :: psb_z_null_prec_type contains - procedure, pass(prec) :: apply => z_null_apply - procedure, pass(prec) :: precbld => z_null_precbld - procedure, pass(prec) :: precinit => z_null_precinit - procedure, pass(prec) :: precseti => z_null_precseti - procedure, pass(prec) :: precsetr => z_null_precsetr - procedure, pass(prec) :: precsetc => z_null_precsetc - procedure, pass(prec) :: precfree => z_null_precfree - procedure, pass(prec) :: precdescr => z_null_precdescr - procedure, pass(prec) :: sizeof => z_null_sizeof + procedure, pass(prec) :: apply => psb_z_null_apply + procedure, pass(prec) :: precbld => psb_z_null_precbld + procedure, pass(prec) :: precinit => psb_z_null_precinit + procedure, pass(prec) :: precseti => psb_z_null_precseti + procedure, pass(prec) :: precsetr => psb_z_null_precsetr + procedure, pass(prec) :: precsetc => psb_z_null_precsetc + procedure, pass(prec) :: precfree => psb_z_null_precfree + procedure, pass(prec) :: precdescr => psb_z_null_precdescr + procedure, pass(prec) :: sizeof => psb_z_null_sizeof end type psb_z_null_prec_type + private :: psb_z_null_apply, psb_z_null_precbld, psb_z_null_precseti,& + & psb_z_null_precsetr, psb_z_null_precsetc, psb_z_null_sizeof,& + & psb_z_null_precinit, psb_z_null_precfree, psb_z_null_precdescr + contains - subroutine z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_sparse_mod type(psb_desc_type),intent(in) :: desc_data class(psb_z_null_prec_type), intent(in) :: prec @@ -70,10 +74,10 @@ contains end if return - end subroutine z_null_apply + end subroutine psb_z_null_apply - subroutine z_null_precinit(prec,info) + subroutine psb_z_null_precinit(prec,info) use psb_sparse_mod Implicit None @@ -98,9 +102,9 @@ contains return end if return - end subroutine z_null_precinit + end subroutine psb_z_null_precinit - subroutine z_null_precbld(a,desc_a,prec,info,upd) + subroutine psb_z_null_precbld(a,desc_a,prec,info,upd) use psb_sparse_mod Implicit None @@ -128,9 +132,9 @@ contains return end if return - end subroutine z_null_precbld + end subroutine psb_z_null_precbld - subroutine z_null_precseti(prec,what,val,info) + subroutine psb_z_null_precseti(prec,what,val,info) use psb_sparse_mod Implicit None @@ -156,9 +160,9 @@ contains return end if return - end subroutine z_null_precseti + end subroutine psb_z_null_precseti - subroutine z_null_precsetr(prec,what,val,info) + subroutine psb_z_null_precsetr(prec,what,val,info) use psb_sparse_mod Implicit None @@ -184,9 +188,9 @@ contains return end if return - end subroutine z_null_precsetr + end subroutine psb_z_null_precsetr - subroutine z_null_precsetc(prec,what,val,info) + subroutine psb_z_null_precsetc(prec,what,val,info) use psb_sparse_mod Implicit None @@ -212,9 +216,9 @@ contains return end if return - end subroutine z_null_precsetc + end subroutine psb_z_null_precsetc - subroutine z_null_precfree(prec,info) + subroutine psb_z_null_precfree(prec,info) use psb_sparse_mod Implicit None @@ -240,10 +244,10 @@ contains end if return - end subroutine z_null_precfree + end subroutine psb_z_null_precfree - subroutine z_null_precdescr(prec,iout) + subroutine psb_z_null_precdescr(prec,iout) use psb_sparse_mod Implicit None @@ -278,9 +282,9 @@ contains end if return - end subroutine z_null_precdescr + end subroutine psb_z_null_precdescr - function z_null_sizeof(prec) result(val) + function psb_z_null_sizeof(prec) result(val) use psb_sparse_mod class(psb_z_null_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val @@ -288,6 +292,6 @@ contains val = 0 return - end function z_null_sizeof + end function psb_z_null_sizeof end module psb_z_nullprec diff --git a/prec/psb_z_prec_type.f03 b/prec/psb_z_prec_type.f03 index 4fe28ba1..c45194e6 100644 --- a/prec/psb_z_prec_type.f03 +++ b/prec/psb_z_prec_type.f03 @@ -42,20 +42,7 @@ module psb_z_prec_type & psb_z_sparse_mat use psb_prec_const_mod - - type psb_z_base_prec_type - contains - procedure, pass(prec) :: apply => z_base_apply - procedure, pass(prec) :: precbld => z_base_precbld - procedure, pass(prec) :: precseti => z_base_precseti - procedure, pass(prec) :: precsetr => z_base_precsetr - procedure, pass(prec) :: precsetc => z_base_precsetc - procedure, pass(prec) :: sizeof => z_base_sizeof - generic, public :: precset => precseti, precsetr, precsetc - procedure, pass(prec) :: precinit => z_base_precinit - procedure, pass(prec) :: precfree => z_base_precfree - procedure, pass(prec) :: precdescr => z_base_precdescr - end type psb_z_base_prec_type + use psb_z_base_prec_mod type psb_zprec_type class(psb_z_base_prec_type), allocatable :: prec @@ -81,7 +68,6 @@ module psb_z_prec_type module procedure psb_zprec_sizeof end interface - interface psb_precaply subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work) use psb_sparse_mod, only : psb_desc_type, psb_dpk_ @@ -310,288 +296,4 @@ contains end subroutine z_apply1v - subroutine z_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) - use psb_sparse_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_z_base_prec_type), intent(in) :: prec - complex(psb_dpk_),intent(in) :: alpha, beta - complex(psb_dpk_),intent(in) :: x(:) - complex(psb_dpk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans - complex(psb_dpk_),intent(inout), optional, target :: work(:) - Integer :: err_act, nrow - character(len=20) :: name='z_base_prec_apply' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine z_base_apply - - subroutine z_base_precinit(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_z_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='z_base_precinit' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_base_precinit - - subroutine z_base_precbld(a,desc_a,prec,info,upd) - - use psb_sparse_mod - Implicit None - - type(psb_z_sparse_mat), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - class(psb_z_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - character, intent(in), optional :: upd - Integer :: err_act, nrow - character(len=20) :: name='z_base_precbld' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_base_precbld - - subroutine z_base_precseti(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_z_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - integer, intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='z_base_precseti' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_base_precseti - - subroutine z_base_precsetr(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_z_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='z_base_precsetr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_base_precsetr - - subroutine z_base_precsetc(prec,what,val,info) - - use psb_sparse_mod - Implicit None - - class(psb_z_base_prec_type),intent(inout) :: prec - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, nrow - character(len=20) :: name='z_base_precsetc' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_base_precsetc - - subroutine z_base_precfree(prec,info) - - use psb_sparse_mod - Implicit None - - class(psb_z_base_prec_type), intent(inout) :: prec - integer, intent(out) :: info - - Integer :: err_act, nrow - character(len=20) :: name='z_base_precfree' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine z_base_precfree - - - subroutine z_base_precdescr(prec,iout) - - use psb_sparse_mod - Implicit None - - class(psb_z_base_prec_type), intent(in) :: prec - integer, intent(in), optional :: iout - - Integer :: err_act, nrow, info - character(len=20) :: name='z_base_precdescr' - - call psb_erractionsave(err_act) - - ! - ! This is the base version and we should throw an error. - ! Or should it be the NULL preonditioner??? - ! - info = 700 - call psb_errpush(info,name) - goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - - end subroutine z_base_precdescr - - - function z_base_sizeof(prec) result(val) - use psb_sparse_mod - class(psb_z_base_prec_type), intent(in) :: prec - integer(psb_long_int_k_) :: val - - val = 0 - return - end function z_base_sizeof - end module psb_z_prec_type