Fortran Coder

查看: 5071|回复: 2
打印 上一主题 下一主题

[数学库] MKL Scalapack 求解线性方程组的问题

[复制链接]

2

帖子

1

主题

0

精华

入门

科研路上的小瘪三

F 币
45 元
贡献
14 点
跳转到指定楼层
楼主
发表于 2020-1-27 15:31:14 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 一叶之秋 于 2020-1-27 16:26 编辑

最近想将一个重要的程序中线性方程组的求解改成并行的,工具为Intel MKL库中集成的Scalapack。准备工作如下:
1) 安装了mpich2(64 bit)并通过运行cpi.exe测试成功。
2)环境变量中,在path中添加了mpich2的路径
3)在VS项目中进行了计算环境的配置。
      a.项目属性:use intel MKL=Parallel; linker-input='mkl_blas95_ilp64.lib mkl_lapack95_ilp64.lib mkl_scalapack_ilp64.lib mkl_intel_ilp64.lib mkl_sequential.lib mkl_core.lib mkl_blacs_mpich2_ilp64.lib mpi.lib fmpich2.lib'
      b.选项与设置:executables、libraries 、Includes均已添加相关路径

代码如下:
[Fortran] 纯文本查看 复制代码
MODULE TestM

CONTAINS

    !******************************************
    SUBROUTINE Test(A,D,N,M)
    IMPLICIT NONE
    INTEGER,PARAMETER::dp=kind(1.0D0)
    INTEGER::N,M
    REAL(dp),ALLOCATABLE::A(:,:)
    REAL(dp),ALLOCATABLE::D(:,:)
    !本程序用到的局部变量
    INTEGER::fnum,i,j,err
    
    M=1
    fnum=10
    OPEN(fnum,file='eq.dat')
    READ(fnum,*)N
    ALLOCATE(A(N,N),stat=err)
    IF(err/=0)GOTO 997
    ALLOCATE(D(N,M),stat=err)
    IF(err/=0)GOTO 997

    DO j=1,N
    READ(fnum,*)(A(i,j),i=1,N)
    ENDDO
    READ(fnum,*)(D(i,1),i=1,N)
    CLOSE(fnum)

    GOTO 1000
    997 WRITE(*,*)'子程序Test空间不足'
    STOP
    1000END SUBROUTINE Test
END MODULE TestM


PROGRAM main
USE TestM
IMPLICIT NONE
INTEGER,PARAMETER::dp=kind(1.0D0)
INTEGER::N,M
REAL(dp),ALLOCATABLE::A(:,:)
REAL(dp),ALLOCATABLE::D(:,:)
!本程序用到的局部变量、
INTEGER::i,j


!-----读文件
CALL Test(A,D,N,M)
CALL RBF_slove_equation(A,D,N,M)
END PROGRAM main

SUBROUTINE RBF_slove_equation(A,D,N,M)
!use mpi
!use mkl_service
implicit double precision(a-h,o-z)
real(kind=8)::A(N,N),D(N,M)
character(len=1):: ORDER
integer,parameter::IA = 1, JA = 1, IB = 1, JB = 1,   & 
     &           MB = 2, NB = 2, NRHS = 1,irsrc=0,icsrc=0
integer::desca(9),descb(9),IPIV( N+NB )

ORDER='R'
NPROW = 2
NPCOL = 2

CALL BLACS_GET(-1, 0, ICTXT)

CALL BLACS_GRIDINIT(ICTXT, ORDER, NPROW, NPCOL)   !     INITIALIZE THE PROCESS GRID
write(*,*)'ICTXT',ICTXT
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )

!CALL BLACS_GRIDINFO(ICTXT, NPROW, NPCOL, MYROW, MYCOL)
write(*,*)'MYROW, MYCOL',MYROW, MYCOL

!CALL DESCINIT (desc, m, n, mb, nb, irsrc, icsrc, ictxt, lld, info)
call DESCINIT(desca,n,n,mb, nb,irsrc, icsrc,ICTXT,N,INFO)  
call DESCINIT(descb,n,NRHS,mb, nb,irsrc, icsrc,ICTXT,n,INFO)
write(*,*)'n',n

!-----求解
call pdgesv(n, nrhs, a, ia, ja, desca, ipiv, D, ib, jb, descb, info)

OPEN(10,file='res.dat')
WRITE(10,*)(D(i,M),i=1,N)
CLOSE(10)
 
END !! RBF_slove_equation


程序可以编译成功,但是执行时会出现错误,采用MPIEXEC wrapper 运行可执行程序结果如下:
C:\Users\Administrator\Desktop\GridDeform22222\1.png



采用cmd 运行可执行程序结果如下:



C:\Users\Administrator\Desktop\GridDeform22222\2.png
两个结果好像有点区别。但都是在在BLACS_GRIDINIT这个mkl子程序出的问题,请大神帮忙看下怎么解决这个问题。
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩
虽败犹荣是骗人的

835

帖子

2

主题

0

精华

大宗师

F 币
3926 元
贡献
2334 点
沙发
发表于 2020-1-31 18:46:36 | 只看该作者
试试添加mpi的 initial 和 final

2

帖子

1

主题

0

精华

入门

科研路上的小瘪三

F 币
45 元
贡献
14 点
板凳
 楼主| 发表于 2020-2-1 22:55:10 | 只看该作者
li913 发表于 2020-1-31 18:46
试试添加mpi的 initial 和 final

您好  我按您的提示尝试了下还是老样子。 我让我同学帮我试了试,发现代码本身没有问题,他们都能正常运行。最终确认出问题与MPI相关,如帖子中所述,我用MPICH2的mpiexec wrappe执行exe的时候就会顺利调用BLACS_GRIDINIT函数,但是用命令提示符cmd就不行。后来,我在Intel MPI环境下运行exe,也不能正常执行BLACS_GRIDINIT函数
虽败犹荣是骗人的
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-12-26 20:52

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表