Call Paralution Solver from Fortran

Abstract: Paralution is an open source library for sparse iterative methods with special focus on multi-core and accelerator technology such as GPUs. It has a simple fortran interface and not well designed for multiple right-hand-sides. Here we defined a user friendly interface based on ISO_C_BINDING for Fortran FEA programmes to call Paralution solver.

keywords: Paralution, Fortran, sparse iterative method, iso_c_binding, FEA

  Paralution系由瑞典科研工作者开发的基于多种稀疏矩阵迭代求解方法的C++并行计算程序包。它支持包括OpenMP、GPU/CUDA、OpenCL、OpenMP/MIC等多种后台并行库,也允许通过MPI进行多节点并行加速计算。它是多许可证的开源软件,方便易用,且不依赖特定的硬件平台和软件库,支持主流的Linux、Windows和MacOS操作平台。具体内容可以参考其官方主页:www.paralution.com

  Paralution附带的算例中有Fortran调用的例子,只是对于有限元程序而言通常求解线性方程组AX=B的时候,右端项B不是向量形式而是矩阵形式。其次,在动力计算中总刚的稀疏结构通常而言并不发生改变,所以迭代求解器和预处理只需进行一次,这也是软件包附带算例没有考虑的。

  在有限元分析中调用Paralution计算线性稀疏方程组AX=B的一般步骤是:

1、初始化paralution环境;

2、设置求解器并导入总刚;

3、分析求解X;

4、退出并清空paralution环境

具体的介绍详见代码和算例

CPP code:

 #include <paralution.hpp>

 namespace fortran_module{
// Fortran interface via iso_c_binding
/*
Author: T.Q
Date: 2014.11
Version: 1.1
License: GPL v3
*/
extern "C"
{
// Initialize paralution
void paralution_f_init();
// Print info of paralution
void paralution_f_info();
// Build solver and preconditioner of paralution
void paralution_f_build(const int[], const int[], const double[], int ,int);
// Solve Ax=b
void paralution_f_solve(const double[], double[], int , int&, double&, int&);
// Stop paralution
void paralution_f_stop();
// Subspace method for compute general eigenpairs
//void paralution_f_subspace();
} int *row = NULL;// Row index
int *col = NULL;// Column index
int *row_offset = NULL;// Row offset index for CSR
double *val = NULL;// Value of sparse matrix double *in_x = NULL;// Internal x vector
double *in_rhs = NULL;// Internal rhs vector bool var_clear = false;// Flag of variables clearance
bool ls_build = false;// Flag of solver exist using namespace paralution; LocalMatrix<double> *mat_A = NULL;// Matrix A i.e. Stiffness matrix in FEM
LocalMatrix<double> *mat_B = NULL;// Matrix B i.e. Mass matrix in FEM // Iterative Linear Solver and Preconditioner
IterativeLinearSolver<LocalMatrix<double>, LocalVector<double>, double> *ls = NULL;
Preconditioner<LocalMatrix<double>, LocalVector<double>, double> *pr = NULL; void paralution_f_clear()
{
// Clear variables if(ls!=NULL){ ls->Clear(); delete ls;}
if(pr!=NULL){ pr->Clear(); delete pr;} if(row!=NULL)free_host(&row);
if(col!=NULL)free_host(&col);
if(row_offset!=NULL)free_host(&row_offset);
if(val!=NULL)free_host(&val); if(in_x!=NULL)free_host(&in_x);
if(in_rhs!=NULL)free_host(&in_rhs); if(mat_A!=NULL){ mat_A->Clear(); delete mat_A;}
if(mat_B!=NULL){ mat_B->Clear(); delete mat_B;} var_clear = true;
ls_build = false;
} void paralution_f_init()
{
paralution_f_clear();
init_paralution();
} void paralution_f_info()
{
info_paralution();
} void paralution_f_stop()
{
paralution_f_clear();
stop_paralution();
} void paralution_f_build(const int for_row[], const int for_col[],
const double for_val[], int n, int nnz)
{
int i; if(var_clear==false)paralution_f_clear(); // Allocate arrays
allocate_host(nnz,&row);
allocate_host(nnz,&col);
allocate_host(nnz,&val); // Copy sparse matrix data F2C
for(i=;i<nnz;i++){
row[i] = for_row[i] - ;// Fortran starts with 1 default
col[i] = for_col[i] - ;
val[i] = for_val[i];} // Load data
mat_A = new LocalMatrix<double>;
mat_A->SetDataPtrCOO(&row,&col,&val,"Imported Fortran COO Matrix", nnz, n, n);
mat_A->ConvertToCSR();// Manual suggest CSR format
mat_A->info(); // Creat Solver and Preconditioner
ls = new CG<LocalMatrix<double>, LocalVector<double>, double>;
pr = new Jacobi<LocalMatrix<double>, LocalVector<double>, double>; ls->Clear();
ls->SetOperator(*mat_A);
ls->SetPreconditioner(*pr);
ls->Build(); ls_build = true; } void paralution_f_solve(const double for_rhs[], double for_x[], int n,
int &iter, double &resnorm, int &err)
{
int i;
LocalVector<double> x;// Solution vector
LocalVector<double> rhs;// Right-hand-side vector assert(ls_build==true); if(in_rhs!=NULL)free_host(&in_rhs);
if(in_x!=NULL)free_host(&in_x); allocate_host(n,&in_rhs);
allocate_host(n,&in_x);
// Copy and set rhs vector
for(i=;i<n;i++){ in_rhs[i] = for_rhs[i];}
rhs.SetDataPtr(&in_rhs,"vector",n);
// Set solution to zero
x.Allocate("vector",n);
x.Zeros();
// Solve
ls->Solve(rhs,&x);
// Get solution
x.LeaveDataPtr(&in_x);
// Copy to array
for(i=;i<n;i++){ for_x[i] = in_x[i];}
// Clear
x.Clear();
rhs.Clear();
// Get information
iter = ls->GetIterationCount();// iteration times
resnorm = ls->GetCurrentResidual();// residual
err = ls->GetSolverStatus();// error code
}
// TODO
// Subspace method for solve general eigenpairs for symmetric real positive
// defined matrix
// A*x=lambda*M*x
// A: matrix N*N i.e. stiffness matrix
// B: matrix N*N i.e. mass matrix
//
void paralution_f_subspace(const int for_row[], const int for_col[],
const int option[], const double for_stif[], const double for_mass[],
double eigval[], double eigvec[], int n, int nnz)
{
}
}

Fortran code:

 module paralution
use,intrinsic::iso_c_binding
implicit none
!*******************************************************************************
! Fortran module for call Paralution package
!-------------------------------------------------------------------------------
! Author: T.Q.
! Date: 2014.11
! Version: 1.1
!*******************************************************************************
! License: GPL v3
!-------------------------------------------------------------------------------
! usage:
!-------------------------------------------------------------------------------
! ) call paralution_init
! ) call paralution_info (optional)
! ) call paralution_build
! ) call paralution_solve (support multi-rhs)
! ) call paralution_stop
!*******************************************************************************
interface
subroutine paralution_init()bind(c,name='paralution_f_init')
end subroutine
subroutine paralution_info()bind(c,name='paralution_f_info')
end subroutine
subroutine paralution_stop()bind(c,name='paralution_f_stop')
end subroutine
subroutine paralution_build(row,col,val,n,nnz)bind(c,name='paralution_f_build')
import
implicit none
integer(c_int),intent(in),value::n,nnz
integer(c_int),intent(in)::row(nnz),col(nnz)
real(c_double),intent(in)::val(nnz)
end subroutine
subroutine paralution_solve_vec(rhs,x,n,iter,resnorm,err2)bind(c,name='paralution_f_solve')
import
implicit none
integer(c_int),intent(in),value::n
real(c_double),intent(in)::rhs(n)
real(c_double)::x(n)
integer(c_int)::iter,err2
real(c_double)::resnorm
end subroutine
end interface
contains
subroutine paralution_solve(rhs,x,mat_rhs,mat_x,n,iter,resnorm,err2)
implicit none
integer(c_int)::n,iter,err2
real(c_double),intent(in),optional::rhs(:),mat_rhs(:,:)
real(c_double),optional::x(:),mat_x(:,:)
real(c_double)::resnorm logical::isVec,isMat
integer::i
isVec = present(rhs).and.present(x)
isMat = present(mat_rhs).and.present(mat_x) if(isVec.and.(.not.isMat))then
! rhs and x both vector
call paralution_solve_vec(rhs,x,n,iter,resnorm,err2)
elseif(isMat)then
! rhs and x both matrix
do i=,size(mat_rhs,)
call paralution_solve_vec(mat_rhs(:,i),mat_x(:,i),n,iter,resnorm,err2)
enddo
else
write(*,*)"Error too many input variables"
endif
return
end subroutine
end module program test
use paralution
implicit none
real(kind=)::a(,),b(,),x(,),val(),res2
integer::i,j,k,row(),col(),err2
a = .D0
a(,[,]) = [.7D0, .13D0]
a(,[,,]) = [.D0, .02D0, .01D0]
a(,) = .5D0
a(,) = .1D0
a(,::) = [.6D0,.D0,.16D0,.09D0,.52D0,.53D0]
a(,) = .2D0
a(,[,]) = [.3D0, .56D0]
a(,:) = [.6D0, .11D0]
a(,) = .4D0
a(,) = .1D0 write(*,*)"Data initialize"
do i=,size(a,)
do j=min(i+,size(a,)),size(a,)
a(j,i) = a(i,j)
enddo
enddo k=
do i=,size(a,)
do j=,size(a,)
if(a(i,j)>.D-)then
row(k) = i
col(k) = j
val(k) = a(i,j)
write(*,*)i,j,val(k)
k = k +
endif
enddo
enddo
b(:,) = [.287D0, .22D0, .45D0, .44D0, .486D0, .72D0, .55D0, .424D0, .621D0, .759D0]
b(:,) = .5D0*b(:,)
x = .D0 i =
j =
k =
call paralution_init()
call paralution_info()
call paralution_build(row,col,val,i,j)
do k=,
call paralution_solve(rhs=b(:,k),x=x(:,k),n=i,iter=j,resnorm=res2,err2=err2)
write(*,*)"Iter times:",j," relative error:",res2," error code:",err2
write(*,*)x(:,k)
enddo
call paralution_solve(mat_rhs=b,mat_x=x,n=i,iter=j,resnorm=res2,err2=err2)
do k=,
write(*,*)"Iter times:",j," relative error:",res2," error code:",err2
write(*,*)x(:,k)
enddo
call paralution_stop()
end program

result:

  Data initialize
1 1 1.7000000000000000
1 9 0.13000000000000000
2 2 1.0000000000000000
2 5 2.0000000000000000E-002
2 10 1.0000000000000000E-002
3 3 1.5000000000000000
4 4 1.1000000000000001
5 2 2.0000000000000000E-002
5 5 2.6000000000000001
5 7 0.16000000000000000
5 8 8.9999999999999997E-002
5 9 0.52000000000000002
5 10 0.53000000000000003
6 6 1.2000000000000000
7 5 0.16000000000000000
7 7 1.3000000000000000
7 10 0.56000000000000005
8 5 8.9999999999999997E-002
8 8 1.6000000000000001
8 9 0.11000000000000000
9 1 0.13000000000000000
9 5 0.52000000000000002
9 8 0.11000000000000000
9 9 1.3999999999999999
10 2 1.0000000000000000E-002
10 5 0.53000000000000003
10 7 0.56000000000000005
10 10 3.1000000000000001
This version of PARALUTION is released under GPL.
By downloading this package you fully agree with the GPL license.
Number of CPU cores: 2
Host thread affinity policy - thread mapping on every core
PARALUTION ver B0.8.0
PARALUTION platform is initialized
Accelerator backend: None
OpenMP threads:2
LocalMatrix name=Imported Fortran COO Matrix; rows=10; cols=10; nnz=28; prec=64bit; asm=no; format=CSR; host backend={CPU(OpenMP)}; accelerator backend={None}; current=CPU(OpenMP)
PCG solver starts, with preconditioner:
Jacobi preconditioner
IterationControl criteria: abs tol=1e-15; rel tol=1e-06; div tol=1e+08; max iter=1000000
IterationControl initial residual = 5.33043
IterationControl RELATIVE criteria has been reached: res norm=6.83208e-07; rel val=1.28171e-07; iter=6
PCG ends
Iter times: 6 relative error: 6.8320832955793363E-007 error code: 2
0.10000029331886898 0.19999984686691041 0.30000008316594051 0.40000011088792048 0.49999997425190351 0.60000016633188091 0.70000002413346363 0.79999978910736969 0.90000002416832581 1.0000000083185150
PCG solver starts, with preconditioner:
Jacobi preconditioner
IterationControl criteria: abs tol=1e-15; rel tol=1e-06; div tol=1e+08; max iter=1000000
IterationControl initial residual = 7.99564
IterationControl RELATIVE criteria has been reached: res norm=1.02481e-06; rel val=1.28171e-07; iter=6
PCG ends
Iter times: 6 relative error: 1.0248124943384603E-006 error code: 2
0.15000043997830351 0.29999977030036568 0.45000012474891066 0.60000016633188091 0.74999996137785507 0.90000024949782143 1.0500000362001956 1.1999996836610549 1.3500000362524884 1.5000000124777721
PCG solver starts, with preconditioner:
Jacobi preconditioner
IterationControl criteria: abs tol=1e-15; rel tol=1e-06; div tol=1e+08; max iter=1000000
IterationControl initial residual = 5.33043
IterationControl RELATIVE criteria has been reached: res norm=6.83208e-07; rel val=1.28171e-07; iter=6
PCG ends
PCG solver starts, with preconditioner:
Jacobi preconditioner
IterationControl criteria: abs tol=1e-15; rel tol=1e-06; div tol=1e+08; max iter=1000000
IterationControl initial residual = 7.99564
IterationControl RELATIVE criteria has been reached: res norm=1.02481e-06; rel val=1.28171e-07; iter=6
PCG ends
Iter times: 6 relative error: 1.0248124943384603E-006 error code: 2
0.10000029331886898 0.19999984686691041 0.30000008316594051 0.40000011088792048 0.49999997425190351 0.60000016633188091 0.70000002413346363 0.79999978910736969 0.90000002416832581 1.0000000083185150
Iter times: 6 relative error: 1.0248124943384603E-006 error code: 2
0.15000043997830351 0.29999977030036568 0.45000012474891066 0.60000016633188091 0.74999996137785507 0.90000024949782143 1.0500000362001956 1.1999996836610549 1.3500000362524884 1.5000000124777721
上一篇:Windows 10开发基础——VS2015 Update1新建UWP项目,XAML设计器无法加载的解决


下一篇:VS2017的MVC和Angular联合开发的配置文件作用