[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
