fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-11 16:39:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
prec/Makefile
 prec/psb_c_base_prec_mod.f03
 prec/psb_c_bjacprec.f03
 prec/psb_c_diagprec.f03
 prec/psb_c_nullprec.f03
 prec/psb_c_prec_type.f03
 prec/psb_d_base_prec_mod.f03
 prec/psb_d_bjacprec.f03
 prec/psb_d_diagprec.f03
 prec/psb_d_nullprec.f03
 prec/psb_d_prec_type.f03
 prec/psb_s_base_prec_mod.f03
 prec/psb_s_bjacprec.f03
 prec/psb_s_diagprec.f03
 prec/psb_s_nullprec.f03
 prec/psb_s_prec_type.f03
 prec/psb_z_base_prec_mod.f03
 prec/psb_z_bjacprec.f03
 prec/psb_z_diagprec.f03
 prec/psb_z_nullprec.f03
 prec/psb_z_prec_type.f03

Restructured PREC inheritance chain.
This commit is contained in:
Salvatore Filippone
2010-04-27 15:17:31 +00:00
parent 070b15cdb9
commit 5ceb49d165
21 changed files with 1805 additions and 1545 deletions
Download Patch File Download Diff File Expand all files Collapse all files
prec/Makefile
+10 -5
View File
@@ -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)
prec/psb_c_base_prec_mod.f03
+351
View File
@@ -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
prec/psb_c_bjacprec.f03
+32 -28
View File
@@ -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
prec/psb_c_diagprec.f03
+32 -28
View File
@@ -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
prec/psb_c_nullprec.f03
+32 -29
View File
@@ -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
prec/psb_c_prec_type.f03
+1 -299
View File
@@ -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
prec/psb_d_base_prec_mod.f03
+352
View File
@@ -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
prec/psb_d_bjacprec.f03
+32 -28
View File
@@ -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
prec/psb_d_diagprec.f03
+32 -28
View File
@@ -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
prec/psb_d_nullprec.f03
+32 -29
View File
@@ -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
prec/psb_d_prec_type.f03
+1 -298
View File
@@ -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
prec/psb_s_base_prec_mod.f03
+352
View File
@@ -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
prec/psb_s_bjacprec.f03
+32 -28
View File
@@ -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
prec/psb_s_diagprec.f03
+32 -28
View File
@@ -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
prec/psb_s_nullprec.f03
+32 -30
View File
@@ -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
prec/psb_s_prec_type.f03
+1 -304
View File
@@ -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
prec/psb_z_base_prec_mod.f03
+352
View File
@@ -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
prec/psb_z_bjacprec.f03
+32 -28
View File
@@ -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
prec/psb_z_diagprec.f03
+32 -28
View File
@@ -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
prec/psb_z_nullprec.f03
+32 -28
View File
@@ -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
prec/psb_z_prec_type.f03
+1 -299
View File
@@ -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