fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/Makefile
 mlprec/mld_base_prec_type.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_umf_solver.f90
 mlprec/mld_dumf_interface.c
 mlprec/mld_z_prec_type.f90
 mlprec/mld_z_umf_solver.f90
 mlprec/mld_zumf_interface.c
 tests/fileread/cf_sample.f90
 tests/fileread/df_sample.f90
 tests/fileread/runs/cfs.inp
 tests/fileread/runs/dfs.inp
 tests/fileread/runs/sfs.inp
 tests/fileread/runs/zfs.inp
 tests/fileread/sf_sample.f90
 tests/fileread/zf_sample.f90
 tests/pdegen/runs/ppde.inp

Define Z_UMF_SOLVER.
This commit is contained in:
Salvatore Filippone
2011-01-05 12:09:06 +00:00
parent de26076648
commit 5da43576d9
17 changed files with 560 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/Makefile
+17 -1
View File
@@ -14,7 +14,7 @@ MODOBJS=mld_base_prec_type.o \
mld_s_ilu_solver.o mld_s_diag_solver.o mld_s_jac_smoother.o mld_s_as_smoother.o \
mld_c_ilu_solver.o mld_c_diag_solver.o mld_c_jac_smoother.o mld_c_as_smoother.o \
mld_z_ilu_solver.o mld_z_diag_solver.o mld_z_jac_smoother.o mld_z_as_smoother.o \
mld_d_umf_solver.o
mld_d_umf_solver.o mld_z_umf_solver.o
MPFOBJS=mld_daggrmat_nosmth_asb.o mld_daggrmat_smth_asb.o mld_daggrmat_minnrg_asb.o \
mld_saggrmat_nosmth_asb.o mld_saggrmat_smth_asb.o \
mld_caggrmat_nosmth_asb.o mld_caggrmat_smth_asb.o \
@@ -72,6 +72,22 @@ mld_d_as_smoother.o mld_d_jac_smoother.o: mld_d_prec_type.o
mld_d_jac_smoother.o: mld_d_diag_solver.o
mld_dprecinit.o mld_dprecset.o: mld_d_diag_solver.o mld_d_ilu_solver.o \
mld_d_umf_solver.o mld_d_as_smoother.o mld_d_jac_smoother.o
mld_z_umf_solver.o mld_z_diag_solver.o mld_z_ilu_solver.o: mld_z_prec_type.o
mld_z_as_smoother.o mld_z_jac_smoother.o: mld_z_prec_type.o
mld_z_jac_smoother.o: mld_z_diag_solver.o
mld_zprecinit.o mld_zprecset.o: mld_z_diag_solver.o mld_z_ilu_solver.o \
mld_z_umf_solver.o mld_z_as_smoother.o mld_z_jac_smoother.o
mld_s_diag_solver.o mld_s_ilu_solver.o: mld_s_prec_type.o
mld_s_as_smoother.o mld_s_jac_smoother.o: mld_s_prec_type.o
mld_s_jac_smoother.o: mld_s_diag_solver.o
mld_sprecinit.o mld_sprecset.o: mld_s_diag_solver.o mld_s_ilu_solver.o \
mld_s_as_smoother.o mld_s_jac_smoother.o
mld_c_diag_solver.o mld_c_ilu_solver.o: mld_c_prec_type.o
mld_c_as_smoother.o mld_c_jac_smoother.o: mld_c_prec_type.o
mld_c_jac_smoother.o: mld_c_diag_solver.o
mld_cprecinit.o mld_cprecset.o: mld_c_diag_solver.o mld_c_ilu_solver.o \
mld_c_as_smoother.o mld_c_jac_smoother.o
$(MODOBJS): $(PSBINCDIR)/psb_sparse_mod$(.mod)
mlprec/mld_base_prec_type.f90
+2 -1
View File
@@ -75,7 +75,8 @@ module mld_base_prec_type
& psb_cd_get_context, psb_info
use psb_prec_mod, only: psb_sprec_type, psb_dprec_type,&
& psb_cprec_type, psb_zprec_type,&
& psb_d_base_prec_type, psb_s_base_prec_type
& psb_d_base_prec_type, psb_s_base_prec_type, &
& psb_z_base_prec_type, psb_c_base_prec_type
type mld_aux_onelev_map_type
mlprec/mld_c_prec_type.f90
+2 -2
View File
@@ -204,7 +204,7 @@ module mld_c_prec_type
procedure, pass(sm) :: sizeof => c_base_smoother_sizeof
end type mld_c_base_smoother_type
type, extends(psb_s_base_prec_type) :: mld_cbaseprec_type
type, extends(psb_c_base_prec_type) :: mld_cbaseprec_type
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
end type mld_cbaseprec_type
@@ -227,7 +227,7 @@ module mld_c_prec_type
generic, public :: set => seti, setr, setc
end type mld_conelev_type
type, extends(psb_sprec_type) :: mld_cprec_type
type, extends(psb_cprec_type) :: mld_cprec_type
integer :: ictxt
type(mld_conelev_type), allocatable :: precv(:)
contains
mlprec/mld_d_umf_solver.f90
-1
View File
@@ -206,7 +206,6 @@ contains
type(psb_dspmat_type) :: atmp
type(psb_d_csc_sparse_mat) :: acsc
integer :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_umf_solver_bld', ch_err
mlprec/mld_dumf_interface.c
-1
View File
@@ -99,7 +99,6 @@ int mld_dumf_fact(int n, int nnz,
double Info [UMFPACK_INFO], Control [UMFPACK_CONTROL];
void *Symbolic, *Numeric ;
int i, info;
long long int tmp;
umfpack_di_defaults(Control);
mlprec/mld_z_prec_type.f90
+2 -2
View File
@@ -204,7 +204,7 @@ module mld_z_prec_type
procedure, pass(sm) :: sizeof => z_base_smoother_sizeof
end type mld_z_base_smoother_type
type, extends(psb_s_base_prec_type) :: mld_zbaseprec_type
type, extends(psb_z_base_prec_type) :: mld_zbaseprec_type
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
end type mld_zbaseprec_type
@@ -227,7 +227,7 @@ module mld_z_prec_type
generic, public :: set => seti, setr, setc
end type mld_zonelev_type
type, extends(psb_sprec_type) :: mld_zprec_type
type, extends(psb_zprec_type) :: mld_zprec_type
integer :: ictxt
type(mld_zonelev_type), allocatable :: precv(:)
contains
mlprec/mld_z_umf_solver.f90
+470
View File
@@ -0,0 +1,470 @@
!!$
!!$
!!$ MLD2P4 version 2.0
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
!!$
!!$ (C) Copyright 2008,2009,2010, 2010
!!$
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ Pasqua D'Ambra ICAR-CNR, Naples
!!$ Daniela di Serafino Second University of Naples
!!$
!!$ 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 MLD2P4 group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 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 mld_z_umf_solver
use iso_c_binding
use mld_z_prec_type
type, extends(mld_z_base_solver_type) :: mld_z_umf_solver_type
!!$ type(psb_dspmat_type) :: l, u
!!$ real(psb_dpk_), allocatable :: d(:)
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
!!$ integer :: fact_type, fill_in
!!$ real(psb_dpk_) :: thresh
contains
procedure, pass(sv) :: build => z_umf_solver_bld
procedure, pass(sv) :: apply => z_umf_solver_apply
procedure, pass(sv) :: free => z_umf_solver_free
procedure, pass(sv) :: seti => z_umf_solver_seti
procedure, pass(sv) :: setc => z_umf_solver_setc
procedure, pass(sv) :: setr => z_umf_solver_setr
procedure, pass(sv) :: descr => z_umf_solver_descr
procedure, pass(sv) :: sizeof => z_umf_solver_sizeof
end type mld_z_umf_solver_type
private :: z_umf_solver_bld, z_umf_solver_apply, &
& z_umf_solver_free, z_umf_solver_seti, &
& z_umf_solver_setc, z_umf_solver_setr,&
& z_umf_solver_descr, z_umf_solver_sizeof
interface
function mld_zumf_fact(n,nnz,values,rowind,colptr,&
& symptr,numptr,ssize,nsize)&
& bind(c,name='mld_zumf_fact') result(info)
use iso_c_binding
integer(c_int), value :: n,nnz
integer(c_int) :: info
integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowind(*),colptr(*)
complex(c_double_complex) :: values(*)
type(c_ptr) :: symptr, numptr
end function mld_zumf_fact
end interface
interface
function mld_zumf_solve(itrans,n,x, b, ldb, numptr)&
& bind(c,name='mld_zumf_solve') result(info)
use iso_c_binding
integer(c_int) :: info
integer(c_int), value :: itrans,n,ldb
complex(c_double_complex) :: x(*), b(ldb,*)
type(c_ptr), value :: numptr
end function mld_zumf_solve
end interface
interface
function mld_zumf_free(symptr, numptr)&
& bind(c,name='mld_zumf_free') result(info)
use iso_c_binding
integer(c_int) :: info
type(c_ptr), value :: symptr, numptr
end function mld_zumf_free
end interface
contains
subroutine z_umf_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_sparse_mod
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_umf_solver_type), intent(in) :: sv
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:)
integer :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='z_umf_solver_apply'
call psb_erractionsave(err_act)
info = psb_success_
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T','C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
n_row = psb_cd_get_local_rows(desc_data)
n_col = psb_cd_get_local_cols(desc_data)
if (n_col <= size(work)) then
ww => work(1:n_col)
else
allocate(ww(n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
endif
select case(trans_)
case('N')
info = mld_zumf_solve(0,n_row,ww,x,n_row,sv%numeric)
case('T','C')
info = mld_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
end select
if (info == psb_success_) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
goto 9999
endif
if (n_col > size(work)) then
deallocate(ww)
endif
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_umf_solver_apply
subroutine z_umf_solver_bld(a,desc_a,sv,upd,info,b)
use psb_sparse_mod
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_umf_solver_type), intent(inout) :: sv
character, intent(in) :: upd
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target, optional :: b
! Local variables
type(psb_zspmat_type) :: atmp
type(psb_z_csc_sparse_mat) :: acsc
integer :: n_row,n_col, nrow_a, nztota
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_umf_solver_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
if (psb_toupper(upd) == 'F') then
call a%cscnv(atmp,info,type='coo')
call psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='csc',dupl=psb_dupl_add_)
call atmp%mv_to(acsc)
nrow_a = acsc%get_nrows()
nztota = acsc%get_nzeros()
! Fix the entres to call C-base UMFPACK.
acsc%ia(:) = acsc%ia(:) - 1
acsc%icp(:) = acsc%icp(:) - 1
info = mld_zumf_fact(nrow_a,nztota,acsc%val,&
& acsc%ia,acsc%icp,sv%symbolic,sv%numeric,&
& sv%symbsize,sv%numsize)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mld_zumf_fact'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call acsc%free()
call atmp%free()
else
! ?
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'
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_umf_solver_bld
subroutine z_umf_solver_seti(sv,what,val,info)
use psb_sparse_mod
Implicit None
! Arguments
class(mld_z_umf_solver_type), intent(inout) :: sv
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_umf_solver_seti'
info = psb_success_
call psb_erractionsave(err_act)
select case(what)
case default
!!$ write(0,*) name,': Error: invalid WHAT'
!!$ info = -2
end select
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_umf_solver_seti
subroutine z_umf_solver_setc(sv,what,val,info)
use psb_sparse_mod
Implicit None
! Arguments
class(mld_z_umf_solver_type), intent(inout) :: sv
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='z_umf_solver_setc'
info = psb_success_
call psb_erractionsave(err_act)
call mld_stringval(val,ival,info)
if (info == psb_success_) call sv%set(what,ival,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info, name)
goto 9999
end if
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_umf_solver_setc
subroutine z_umf_solver_setr(sv,what,val,info)
use psb_sparse_mod
Implicit None
! Arguments
class(mld_z_umf_solver_type), intent(inout) :: sv
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_umf_solver_setr'
call psb_erractionsave(err_act)
info = psb_success_
select case(what)
case default
!!$ write(0,*) name,': Error: invalid WHAT'
!!$ info = -2
!!$ goto 9999
end select
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_umf_solver_setr
subroutine z_umf_solver_free(sv,info)
use psb_sparse_mod
Implicit None
! Arguments
class(mld_z_umf_solver_type), intent(inout) :: sv
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_umf_solver_free'
call psb_erractionsave(err_act)
info = mld_zumf_free(sv%symbolic,sv%numeric)
if (info /= psb_success_) goto 9999
sv%symbolic = c_null_ptr
sv%numeric = c_null_ptr
sv%symbsize = 0
sv%numsize = 0
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_umf_solver_free
subroutine z_umf_solver_descr(sv,info,iout)
use psb_sparse_mod
Implicit None
! Arguments
class(mld_z_umf_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
integer :: ictxt, me, np
character(len=20), parameter :: name='mld_z_umf_solver_descr'
integer :: iout_
call psb_erractionsave(err_act)
info = psb_success_
if (present(iout)) then
iout_ = iout
else
iout_ = 6
endif
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
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_umf_solver_descr
function z_umf_solver_sizeof(sv) result(val)
use psb_sparse_mod
implicit none
! Arguments
class(mld_z_umf_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
val = 2*psb_sizeof_long_int
val = val + sv%symbsize
val = val + sv%numsize
return
end function z_umf_solver_sizeof
end module mld_z_umf_solver
mlprec/mld_zumf_interface.c
+49 -102
View File
@@ -76,39 +76,6 @@ Availability:
*/
#ifdef LowerUnderscore
#define mld_zumf_fact_ mld_zumf_fact_
#define mld_zumf_solve_ mld_zumf_solve_
#define mld_zumf_free_ mld_zumf_free_
#endif
#ifdef LowerDoubleUnderscore
#define mld_zumf_fact_ mld_zumf_fact__
#define mld_zumf_solve_ mld_zumf_solve__
#define mld_zumf_free_ mld_zumf_free__
#endif
#ifdef LowerCase
#define mld_zumf_fact_ mld_zumf_fact
#define mld_zumf_solve_ mld_zumf_solve
#define mld_zumf_free_ mld_zumf_free
#endif
#ifdef UpperUnderscore
#define mld_zumf_fact_ MLD_ZUMF_FACT_
#define mld_zumf_solve_ MLD_ZUMF_SOLVE_
#define mld_zumf_free_ MLD_ZUMF_FREE_
#endif
#ifdef UpperDoubleUnderscore
#define mld_zumf_fact_ MLD_ZUMF_FACT__
#define mld_zumf_solve_ MLD_ZUMF_SOLVE__
#define mld_zumf_free_ MLD_ZUMF_FREE__
#endif
#ifdef UpperCase
#define mld_zumf_fact_ MLD_ZUMF_FACT
#define mld_zumf_solve_ MLD_ZUMF_SOLVE
#define mld_zumf_free_ MLD_ZUMF_FREE
#endif
#include <stdio.h>
#ifdef Have_UMF_
#include "umfpack.h"
@@ -120,133 +87,113 @@ typedef long long fptr;
typedef int fptr; /* 32-bit by default */
#endif
void
mld_zumf_fact_(int *n, int *nnz,
double *values, int *rowind, int *colptr,
#ifdef Have_UMF_
fptr *symptr,
fptr *numptr,
#else
void *symptr,
void *numptr,
#endif
int *info)
int mld_zumf_fact(int n, int nnz,
double *values, int *rowind, int *colptr,
void **symptr, void **numptr,
long long int *ssize,
long long int *nsize)
{
#ifdef Have_UMF_
double Info [UMFPACK_INFO], Control [UMFPACK_CONTROL];
void *Symbolic, *Numeric ;
int i;
int i, info;
umfpack_zi_defaults(Control);
for (i = 0; i <= *n; ++i) --colptr[i];
for (i = 0; i < *nnz; ++i) --rowind[i];
*info = umfpack_zi_symbolic (*n, *n, colptr, rowind, values, NULL, &Symbolic,
info = umfpack_zi_symbolic (n, n, colptr, rowind, values, NULL, &Symbolic,
Control, Info);
if ( *info == UMFPACK_OK ) {
*info = 0;
if ( info == UMFPACK_OK ) {
info = 0;
} else {
printf("umfpack_zi_symbolic() error returns INFO= %d\n", *info);
*info = -11;
*numptr = (fptr) NULL;
return;
printf("umfpack_zi_symbolic() error returns INFO= %d\n", info);
*symptr = (void *) NULL;
*numptr = (void *) NULL;
return -11;
}
*symptr = (fptr) Symbolic;
*info = umfpack_zi_numeric (colptr, rowind, values, NULL, Symbolic, &Numeric,
*symptr = Symbolic;
*ssize = Info[UMFPACK_SYMBOLIC_SIZE];
*ssize *= Info[UMFPACK_SIZE_OF_UNIT];
info = umfpack_zi_numeric (colptr, rowind, values, NULL, Symbolic, &Numeric,
Control, Info) ;
if ( *info == UMFPACK_OK ) {
*info = 0;
*numptr = (fptr) Numeric;
if ( info == UMFPACK_OK ) {
info = 0;
*numptr = Numeric;
*nsize = Info[UMFPACK_NUMERIC_SIZE];
*nsize *= Info[UMFPACK_SIZE_OF_UNIT];
} else {
printf("umfpack_zi_numeric() error returns INFO= %d\n", *info);
*info = -12;
*numptr = (fptr) NULL;
printf("umfpack_zi_numeric() error returns INFO= %d\n", info);
info = -12;
*numptr = NULL;
}
for (i = 0; i <= *n; ++i) ++colptr[i];
for (i = 0; i < *nnz; ++i) ++rowind[i];
return info;
#else
fprintf(stderr," UMF Not Configured, fix make.inc and recompile\n");
*info=-1;
return -1;
#endif
}
void
mld_zumf_solve_(int *itrans, int *n,
double *x, double *b, int *ldb,
#ifdef Have_UMF_
fptr *numptr,
#else
void *numptr,
#endif
int *info)
int mld_zumf_solve(int itrans, int n,
double *x, double *b, int ldb,
void *numptr)
{
#ifdef Have_UMF_
double Info [UMFPACK_INFO], Control [UMFPACK_CONTROL];
void *Symbolic, *Numeric ;
int i,trans;
int i,trans, info;
umfpack_di_defaults(Control);
Control[UMFPACK_IRSTEP]=0;
if (*itrans == 0) {
if (itrans == 0) {
trans = UMFPACK_A;
} else if (*itrans ==1) {
} else if (itrans ==1) {
trans = UMFPACK_At;
} else {
trans = UMFPACK_A;
}
*info = umfpack_zi_solve(trans,NULL,NULL,NULL,NULL,
x,NULL,b,NULL,(void *) *numptr,Control,Info);
info = umfpack_zi_solve(trans,NULL,NULL,NULL,NULL,
x,NULL,b,NULL, numptr,Control,Info);
return info;
#else
fprintf(stderr," UMF Not Configured, fix make.inc and recompile\n");
*info=-1;
fprintf(stderr," UMF Not Configured, fix make.inc and recompile\n");
return -1;
#endif
}
void
mld_zumf_free_(
#ifdef Have_UMF_
fptr *symptr,
fptr *numptr,
#else
void *symptr,
void *numptr,
#endif
int *info)
int mld_zumf_free(void *symptr, void *numptr)
{
#ifdef Have_UMF_
void *Symbolic, *Numeric ;
Symbolic = (void *) *symptr;
Numeric = (void *) *numptr;
Symbolic = symptr;
Numeric = numptr;
umfpack_zi_free_numeric(&Numeric);
umfpack_zi_free_symbolic(&Symbolic);
*info=0;
return 0;
#else
fprintf(stderr," UMF Not Configured, fix make.inc and recompile\n");
*info=-1;
fprintf(stderr," UMF Not Configured, fix make.inc and recompile\n");
return -1;
#endif
}
tests/fileread/cf_sample.f90
+1 -1
View File
@@ -413,8 +413,8 @@ contains
call read_data(prec%thr,5) ! Threshold for fact. ILU(T)
call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC
if (psb_toupper(prec%prec) == 'ML') then
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%nlev,5) ! Number of levels in multilevel prec.
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin
call read_data(prec%aggr_alg,5) ! local or global aggregation
call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec
tests/fileread/df_sample.f90
+2 -2
View File
@@ -413,14 +413,14 @@ contains
call read_data(prec%thr,5) ! Threshold for fact. ILU(T)
call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC
if (psb_toupper(prec%prec) == 'ML') then
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%nlev,5) ! Number of levels in multilevel prec.
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin
call read_data(prec%aggr_alg,5) ! local or global aggregation
call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec
call read_data(prec%smthpos,5) ! side: pre, post, both smoothing
call read_data(prec%cmat,5) ! coarse mat
call read_data(prec%csolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%csolve,5) ! Factorization type: BJAC, SuperLU, UMFPACK.
call read_data(prec%csbsolve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prec%cfill,5) ! Fill-in for factorization
call read_data(prec%cthres,5) ! Threshold for fact. ILU(T)
tests/fileread/runs/cfs.inp
+2
View File
@@ -17,7 +17,9 @@ NONE ! AS prolongation operator: NONE SUM AVG
ILU ! AS subdomain solver: ILU MILU ILUT UMF SLU
1 ! Fill level P for ILU(P) and ILU(T,P)
1.d-4 ! Threshold T for ILU(T,P)
1 ! Jacobi sweeps
3 ! Number of levels in a multilevel preconditioner
AS ! Smoother type JACOBI BJAC AS ignored for non-ML
SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED MINENERGY
DEC ! Type of aggregation: DEC
MULT ! Type of multilevel correction: ADD MULT
tests/fileread/runs/dfs.inp
+4 -2
View File
@@ -1,4 +1,4 @@
young1r.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or
thm200x120.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE ! rhs | http://www.cise.ufl.edu/research/sparse/matrices/index.html
MM ! File format: MM (Matrix Market) HB (Harwell-Boeing).
BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
@@ -10,14 +10,16 @@ CSR ! Storage format: CSR COO JAD
30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-6 ! EPS
3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars)
AS ! Preconditioner type: NONE DIAG BJAC AS ML
ML ! Preconditioner type: NONE DIAG BJAC AS ML
1 ! Number of overlap layers for AS preconditioner
HALO ! AS restriction operator: NONE HALO
NONE ! AS prolongation operator: NONE SUM AVG
ILU ! AS subdomain solver: ILU MILU ILUT UMF SLU
1 ! Fill level P for ILU(P) and ILU(T,P)
1.d-4 ! Threshold T for ILU(T,P)
1 ! Jacobi sweeps
3 ! Number of levels in a multilevel preconditioner
AS ! Smoother type JACOBI BJAC AS ignored for non-ML
MINENERGY ! Type of aggregation: SMOOTHED NONSMOOTHED MINENERGY
DEC ! Type of aggregation: DEC
MULT ! Type of multilevel correction: ADD MULT
tests/fileread/runs/sfs.inp
+2
View File
@@ -17,7 +17,9 @@ NONE ! AS prolongation operator: NONE SUM AVG
ILU ! AS subdomain solver: ILU MILU ILUT UMF SLU
1 ! Fill level P for ILU(P) and ILU(T,P)
1.d-4 ! Threshold T for ILU(T,P)
1 ! Jacobi sweeps
3 ! Number of levels in a multilevel preconditioner
AS ! Smoother type JACOBI BJAC AS ignored for non-ML
SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED MINENERGY
DEC ! Type of aggregation: DEC
MULT ! Type of multilevel correction: ADD MULT
tests/fileread/runs/zfs.inp
+2
View File
@@ -17,7 +17,9 @@ NONE ! AS prolongation operator: NONE SUM AVG
ILU ! AS subdomain solver: ILU MILU ILUT UMF SLU
1 ! Fill level P for ILU(P) and ILU(T,P)
1.d-4 ! Threshold T for ILU(T,P)
1 ! Jacobi sweeps
3 ! Number of levels in a multilevel preconditioner
AS ! Smoother type JACOBI BJAC AS ignored for non-ML
SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED MINENERGY
DEC ! Type of aggregation: DEC
MULT ! Type of multilevel correction: ADD MULT
tests/fileread/sf_sample.f90
+1 -1
View File
@@ -413,8 +413,8 @@ contains
call read_data(prec%thr,5) ! Threshold for fact. ILU(T)
call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC
if (psb_toupper(prec%prec) == 'ML') then
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%nlev,5) ! Number of levels in multilevel prec.
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin
call read_data(prec%aggr_alg,5) ! local or global aggregation
call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec
tests/fileread/zf_sample.f90
+1 -1
View File
@@ -413,8 +413,8 @@ contains
call read_data(prec%thr,5) ! Threshold for fact. ILU(T)
call read_data(prec%jsweeps,5) ! Jacobi sweeps for PJAC
if (psb_toupper(prec%prec) == 'ML') then
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%nlev,5) ! Number of levels in multilevel prec.
call read_data(prec%smther,5) ! Smoother type.
call read_data(prec%aggrkind,5) ! smoothed/raw aggregatin
call read_data(prec%aggr_alg,5) ! local or global aggregation
call read_data(prec%mltype,5) ! additive or multiplicative 2nd level prec
tests/pdegen/runs/ppde.inp
+3 -3
View File
@@ -1,6 +1,6 @@
BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD
060 ! IDIM; domain size is idim**3
040 ! IDIM; domain size is idim**3
2 ! ISTOPC
0200 ! ITMAX
-1 ! ITRACE
@@ -21,9 +21,9 @@ SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENE
DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
POST ! Side of multiplicative correction PRE POST TWOSIDE (ignored for ADD)
REPL ! Coarse level: matrix distribution DIST REPL
DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST
ILU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
UMF ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
1 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps