fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Taken out extra layer from precfree.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent f743e9ce1f
commit dff1d9c27d
7 changed files with 72 additions and 171 deletions
Show Stats Download Patch File Download Diff File

4
prec/Makefile
Unescape Escape View File

@ -5,13 +5,13 @@ HERE=.
MODOBJS= psb_prec_type.o psb_prec_mod.o
F90OBJS= psb_dilu_bld.o psb_dilu_fct.o\
psb_dsp_renum.o\
psb_dprecbld.o psb_dprecfree.o psb_dprecset.o \
psb_dprecbld.o psb_dprecset.o \
psb_ddiagsc_bld.o \
psb_dprc_aply.o \
psb_dbaseprc_aply.o psb_dbjac_aply.o\
psb_zilu_bld.o psb_zilu_fct.o\
psb_zsp_renum.o\
psb_zprecbld.o psb_zprecfree.o psb_zprecset.o \
psb_zprecbld.o psb_zprecset.o \
psb_zdiagsc_bld.o \
psb_zprc_aply.o psb_zbaseprc_aply.o psb_zbjac_aply.o

2
prec/psb_dprecbld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
!
call psb_check_def(p%iprcparm(p_type_),'base_prec',&
& diagsc_,is_legal_base_prec)
& diagsc_,is_legal_prec)
call psb_nullify_desc(p%desc_data)

63
prec/psb_dprecfree.f90
Unescape Escape View File

@ -1,63 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 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.
!!$
!!$
subroutine psb_dprecfree(p,info)
!...free sparse matrix structure...
use psb_base_mod
use psb_prec_type
implicit none
!....parameters...
type(psb_dprec_type), intent(inout) :: p
integer, intent(out) :: info
!...locals....
integer :: ictxt,me,np,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'psdprecfree'
call psb_erractionsave(err_act)
me=-1
call psb_base_precfree(p,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_dprecfree

28
prec/psb_prec_mod.f90
Unescape Escape View File

@ -81,20 +81,20 @@ module psb_prec_mod
end interface
interface psb_precfree
subroutine psb_dprecfree(p,info)
use psb_base_mod
use psb_prec_type
type(psb_dprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_dprecfree
subroutine psb_zprecfree(p,info)
use psb_base_mod
use psb_prec_type
type(psb_zprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_zprecfree
end interface
!!$ interface psb_precfree
!!$ subroutine psb_dprecfree(p,info)
!!$ use psb_base_mod
!!$ use psb_prec_type
!!$ type(psb_dprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine psb_dprecfree
!!$ subroutine psb_zprecfree(p,info)
!!$ use psb_base_mod
!!$ use psb_prec_type
!!$ type(psb_zprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine psb_zprecfree
!!$ end interface
interface psb_precaply
subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work)

80
prec/psb_prec_type.f90
Unescape Escape View File

@ -85,12 +85,12 @@ module psb_prec_type
& fact_names(0:2)=(/'None ','ILU(n) ',&
& 'ILU(eps) '/)
interface psb_base_precfree
module procedure psb_dbase_precfree, psb_zbase_precfree
interface psb_precfree
module procedure psb_d_precfree, psb_z_precfree
end interface
interface psb_nullify_baseprec
module procedure psb_nullify_dbaseprec, psb_nullify_zbaseprec
interface psb_nullify_prec
module procedure psb_nullify_dprec, psb_nullify_zprec
end interface
interface psb_check_def
@ -120,7 +120,6 @@ contains
integer :: ilev
write(iout,*) 'Preconditioner description'
write(iout,*) 'Base preconditioner'
select case(p%iprcparm(p_type_))
case(noprec_)
write(iout,*) 'No preconditioning'
@ -138,7 +137,6 @@ contains
type(psb_zprec_type), intent(in) :: p
write(iout,*) 'Preconditioner description'
write(iout,*) 'Base preconditioner'
select case(p%iprcparm(p_type_))
case(noprec_)
write(iout,*) 'No preconditioning'
@ -151,13 +149,13 @@ contains
end subroutine psb_zfile_prec_descr
function is_legal_base_prec(ip)
function is_legal_prec(ip)
integer, intent(in) :: ip
logical :: is_legal_base_prec
logical :: is_legal_prec
is_legal_base_prec = ((ip>=noprec_).and.(ip<=bja_))
is_legal_prec = ((ip>=noprec_).and.(ip<=bja_))
return
end function is_legal_base_prec
end function is_legal_prec
function is_legal_renum(ip)
integer, intent(in) :: ip
logical :: is_legal_renum
@ -221,12 +219,17 @@ contains
end if
end subroutine psb_dcheck_def
subroutine psb_dbase_precfree(p,info)
subroutine psb_d_precfree(p,info)
type(psb_dprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
integer :: ictxt,me, np,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'psb_precfree'
call psb_erractionsave(err_act)
info = 0
me=-1
! Actually we migh just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
@ -249,7 +252,7 @@ contains
if (allocated(p%desc_data%matrix_data)) &
& call psb_cdfree(p%desc_data,info)
if (allocated(p%dprcparm)) then
deallocate(p%dprcparm,stat=info)
end if
@ -265,23 +268,38 @@ contains
if (allocated(p%iprcparm)) then
deallocate(p%iprcparm,stat=info)
end if
call psb_nullify_baseprec(p)
end subroutine psb_dbase_precfree
call psb_nullify_prec(p)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
subroutine psb_nullify_dbaseprec(p)
end subroutine psb_d_precfree
subroutine psb_nullify_dprec(p)
type(psb_dprec_type), intent(inout) :: p
!!$ nullify(p%av,p%d,p%iprcparm,p%dprcparm,p%perm,p%invperm,p%mlia,&
!!$ & p%nlaggr,p%base_a,p%base_desc,p%dorig,p%desc_data, p%desc_ac)
end subroutine psb_nullify_dbaseprec
end subroutine psb_nullify_dprec
subroutine psb_zbase_precfree(p,info)
subroutine psb_z_precfree(p,info)
type(psb_zprec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
info = 0
integer :: ictxt,me, np,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'psb_precfree'
call psb_erractionsave(err_act)
if (allocated(p%d)) then
deallocate(p%d,stat=info)
@ -317,14 +335,24 @@ contains
if (allocated(p%iprcparm)) then
deallocate(p%iprcparm,stat=info)
end if
call psb_nullify_baseprec(p)
end subroutine psb_zbase_precfree
call psb_nullify_prec(p)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_precfree
subroutine psb_nullify_zbaseprec(p)
subroutine psb_nullify_zprec(p)
type(psb_zprec_type), intent(inout) :: p
end subroutine psb_nullify_zbaseprec
end subroutine psb_nullify_zprec
function pr_to_str(iprec)

2
prec/psb_zprecbld.f90
Unescape Escape View File

@ -114,7 +114,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
!
call psb_check_def(p%iprcparm(p_type_),'base_prec',&
& diagsc_,is_legal_base_prec)
& diagsc_,is_legal_prec)
call psb_nullify_desc(p%desc_data)

64
prec/psb_zprecfree.f90
Unescape Escape View File

@ -1,64 +0,0 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 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.
!!$
!!$
subroutine psb_zprecfree(p,info)
!...free sparse matrix structure...
use psb_base_mod
use psb_prec_type
implicit none
!....parameters...
type(psb_zprec_type), intent(inout) :: p
integer, intent(out) :: info
!...locals....
integer :: ictxt,me, np,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'pszprecfree'
call psb_erractionsave(err_act)
me=-1
call psb_base_precfree(p,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_zprecfree
Write Preview
Loading…
Cancel
Save