Fortran Coder

查看: 25530|回复: 6
打印 上一主题 下一主题

[数值问题] 运行时出现 Program Exception - access violation,不知道什么原因?

[复制链接]

3

帖子

1

主题

0

精华

新人

F 币
28 元
贡献
13 点
跳转到指定楼层
楼主
发表于 2018-11-16 16:27:15 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
[Fortran] 纯文本查看 复制代码
module gauss
  !高斯消元模块:主要为牛顿法中解线性方程所调用
  contains
  subroutine lineq(A,b,x,N)
    implicit none
    integer(kind=2) :: id_max,i,k,N!主元素标号
    real(kind=8) :: A(N,N),b(N),x(N)
    real(kind=8) :: Aup(N,N),bup(N)
    real(kind=8) :: Ab(N,N+1)  !增广矩阵
    real(kind=8) :: vtemp1(N+1),vtemp2(N+1)
    real(kind=8) :: elmax,temp
    Ab(1:N,1:N) = A
    Ab(:,N+1) = b
    do k=1,N-1
      elmax = dabs(Ab(k,k))
      id_max = k
      do i=k+1,N
        if(abs(Ab(i,k))>elmax) then
          elmax = Ab(i,k)
          id_max = i
        endif
      enddo
      vtemp1 = Ab(k,:)
      vtemp2 = Ab(id_max,:)
      Ab(k,:) = vtemp2
      Ab(id_max,:) = vtemp1
      do i=k+1,N
        temp = Ab(i,k)/Ab(k,k)
        Ab(i,:) = Ab(i,:) - temp*Ab(k,:)
      enddo
    enddo
    Aup(:,:) = Ab(1:N,1:N)
    bup(:) = Ab(:,N+1)
    call uptri(Aup,bup,x,N)
    return
  end subroutine lineq
  
  !上三角线性方程组
  subroutine uptri(A,b,x,N)
    implicit none
    integer(kind=2) :: i,j,N
    real(kind=8) :: A(N,N),b(N),x(N)
    x(N) = b(N)/A(N,N)
    do i=n-1,1,-1
      x(i) = b(i)
      do j=i+1,N
        x(i) = x(i) - A(i,j)*x(j)
      enddo
      x(i) = x(i)/A(i,i)
    enddo
    return 
   end subroutine uptri
end module gauss
  
module newton
  contains
  subroutine solve
    use gauss
    implicit  none
    integer(kind=2) :: i,itmax = 500!最大允许迭代次数
    integer(kind=2) :: p,q,N=2
    real(kind=8) :: x(2),f(2),dx(2)
    real(kind=8) :: x0(2),l
    real(kind=8),allocatable :: s(:),t(:),s0(:),t0(:)
    real(kind=8) :: df(2,2) !偏导数矩阵
    real(kind=8) :: tol,dx2
    q=(p+1)*(p+2)/2
    allocate(s(q))
    allocate(t(q))
    allocate(s0(q))
    allocate(t0(q))
    !随机给定初值
    call RANDOM_SEED()
    call RANDOM_NUMBER(x)
    tol = 1d-4  !计算精度控制
    open(unit=11,file = 'parm.txt')
    read(11,*) p,x0,l
    write(*,*) p,x0,l
    do i=1,q
      read(11,100) s0(i),t0(i) 
      write(*,100) s0(i),t0(i) 
      pause '=============================='
    enddo
    !x = x0 
    s = s0/100
    t = t0/100
100 format(E15.8E2,1x,E15.8E2)
    open(unit=11,file = 'result.txt')
    write(11,101)
101 format(/,t6,'牛顿法计算非线性方程组迭代序列',/) 
    do i=1,itmax 
      call func(f,p,x,s,t,x0,l)
      call jac(df,p,x,s,t,x0,l)
      call lineq(df,-f,dx,N)
      x = x + dx
      write(*,102) i , x*l+x0
102   format(i5,2f16.10)      
      dx2 = dsqrt(dx(1)**2+dx(2)**2)
      if (dx2 < tol) exit
    enddo
    return
  end subroutine solve
  
  subroutine func(f,p,x,s,t,x0,l)
    implicit none
    real(kind=8) :: x(2),f(2)
    real(kind=8) :: x0(2),l
    integer(kind=2) :: p
    integer :: i,j,k=0
    real(kind=8) :: s((p+1)*(p+2)/2),t((p+1)*(p+2)/2)
    f = 0
    !f(1) = s(1)+x0(1)-10+(s(2)+l)*x(1)+s(3)*x(2)+s(4)*x(1)**2+s(5)*x(1)*x(2)+s(6)*x(2)**2+&
    !&s(7)*x(1)**3+s(8)*x(1)**2*x(2)+s(9)*x(1)*x(2)**2+s(10)*x(2)**3!+&
    !&s(11)*x(1)**4+s(12)*x(1)**3*x(2)+s(13)*x(1)**2*x(2)**2+s(14)*x(1)*x(2)**3+s(15)*x(2)**4
    !f(2) = t(1)+x0(2)-4.8+t(2)*x(1)+(t(3)+l)*x(2)+t(4)*x(1)**2+t(5)*x(1)*x(2)+t(6)*x(2)**2+&
    !&t(7)*x(1)**3+t(8)*x(1)**2*x(2)+t(9)*x(1)*x(2)**2+t(10)*x(2)**3!+&
    !&t(11)*x(1)**4+t(12)*x(1)**3*x(2)+t(13)*x(1)**2*x(2)**2+t(14)*x(1)*x(2)**3+t(15)*x(2)**4
    !s(2)=s(2)+l
    !t(3)=t(3)+l
    !s(1)=s(1)+x0(1)-10
    !t(1)=t(1)+x0(1)-4.8
    do i=0,p
      do j=0,i
        k = k+1
        f(1)=f(1)+s(k)*x(1)**(i-j)*x(2)**j
      enddo
    enddo
    k=0    
    do i=0,p
      do j=0,i
        k = k+1
        f(2)=f(2)+t(k)*x(1)**(i-j)*x(2)**j
      enddo
    enddo
  end subroutine func
  subroutine jac(df,p,x,s,t,x0,l)
    implicit none
    real(kind=8) :: x(2),df(2,2)
    integer(kind=2) :: p,i,j,k,m
    real(kind=8) :: s((p+1)*(p+2)/2),t((p+1)*(p+2)/2)
    real(kind=8) :: x0(2),l
    !df(1,1) = s(2)+l+2*s(4)*x(1)+s(5)*x(2)+3*s(7)*x(1)**2+2*s(8)*x(1)*x(2)+s(9)*x(2)**2!+&
              !&4*s(11)*x(1)**3+3*s(12)*x(1)**2*x(2)+2*s(13)*x(1)*x(2)**2+s(14)*x(2)**3
    !df(2,1) = s(3)+s(5)*x(1)+2*s(6)*x(2)+s(8)*x(1)**2+2*s(9)*x(1)*x(2)+3*s(10)*x(2)**3!+&
              !&s(12)*x(1)**3+2*s(13)*x(1)**2*x(2)+3*s(14)*x(1)*x(2)**2+4*s(15)*x(2)**3
    !df(1,2) = t(2)+2*t(4)*x(1)+t(5)*x(2)+3*t(7)*x(1)**2+2*t(8)*x(1)*x(2)+t(9)*x(2)**2!+&
              !&4*t(11)*x(1)**3+3*t(12)*x(1)**2*x(2)+2*t(13)*x(1)*x(2)**2+t(14)*x(2)**3
    !df(2,2) = t(3)+l+t(5)*x(1)+2*t(6)*x(2)+t(8)*x(1)**2+2*t(9)*x(1)*x(2)+3*t(10)*x(2)**3!+&
              !&s(12)*x(1)**3+2*s(13)*x(1)**2*x(2)+3*s(14)*x(1)*x(2)**2+4*s(15)*x(2)**3
    !s(2)=s(2)+l
    !t(3)=t(3)+l           
    df=0         
    !df(1,1)
    m=0
    do i=0,p-1
      k = i+1
      m = m+1
      do j=0,i
        m=m+1
        df(1,1)=df(1,1)+k*s(m)*x(1)**(i-j)*x(2)*j
        k=k-1 
      enddo
    enddo
    !df(1,2)
    m=0
    do i=0,p-1
      k = i+1
      m = m+1
      do j=0,i
        m=m+1
        df(1,2)=df(1,2)+k*t(m)*x(1)**(i-j)*x(2)*j
        k=k-1
      enddo
    enddo
    !df(2,1)
    m=1
    do i=0,p-1
      k = 1
      m = m+1
      do j=0,i
        m=m+1        
        df(2,1)=df(2,1)+k*s(m)*x(1)**(i-j)*x(2)*j
        k=k+1
      enddo
    enddo
    !df(2,2)
    m=1
    do i=0,p-1
      k = 1
      m = m+1
      do j=0,i
        m=m+1        
        df(2,2)=df(2,2)+k*t(m)*x(1)**(i-j)*x(2)*j
        k=k+1
      enddo
    enddo
  end subroutine jac
end module newton
  
  
program main
  use newton
  call solve
end program main
谢谢各位大佬了,帮忙看看

TIM截图20181116162142.png (42.38 KB, 下载次数: 325)

TIM截图20181116162142.png
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

2033

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1643 元
贡献
709 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

沙发
发表于 2018-11-16 17:07:42 | 只看该作者
请提供输入文件

3

帖子

1

主题

0

精华

新人

F 币
28 元
贡献
13 点
板凳
 楼主| 发表于 2018-11-18 14:16:58 | 只看该作者
fcode 发表于 2018-11-16 17:07
请提供输入文件

这是输入文件

parm.txt

439 Bytes, 下载次数: 1

954

帖子

0

主题

0

精华

大师

F 币
184 元
贡献
75 点

规矩勋章元老勋章新人勋章水王勋章热心勋章

QQ
地板
发表于 2018-11-21 21:54:20 | 只看该作者
solve 函数中, p 没有给值
单步调试 http://v.fcode.cn/video-debugger.html

79

帖子

17

主题

0

精华

专家

齊天大聖

F 币
433 元
贡献
266 点
5#
发表于 2018-11-22 13:32:13 | 只看该作者
vvt 发表于 2018-11-21 21:54
solve 函数中, p 没有给值
单步调试 http://v.fcode.cn/video-debugger.html

终端可以单步调试吗?

2033

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1643 元
贡献
709 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

6#
发表于 2018-11-22 17:21:53 | 只看该作者
lookbook 发表于 2018-11-22 13:32
终端可以单步调试吗?

看视频

3

帖子

1

主题

0

精华

新人

F 币
28 元
贡献
13 点
7#
 楼主| 发表于 2018-12-5 23:03:39 | 只看该作者
vvt 发表于 2018-11-21 21:54
solve 函数中, p 没有给值
单步调试 http://v.fcode.cn/video-debugger.html

谢了  已经解决了
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

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

GMT+8, 2024-12-28 02:50

Powered by Tencent X3.4

© 2013-2024 Tencent

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