24小时热门版块排行榜    

北京石油化工学院2026年研究生招生接收调剂公告
查看: 1029  |  回复: 5

曾经电工

金虫 (小有名气)

[交流] 【求助】FORTRAN中增加计算区域后出错, 已有2人参与

开始我计算点为50×100,程序能够正常编译和运行,结果也还是可以。但是当计算点增加到500×100时,可以运行,而出来的结果完全不正确。看了一下数据,发现是在计算浓度场中,增加计算点后其计算值出现负数。不知怎么回事?另外还有一个问题就是计算过程中本来值为1.000000000000000,但是显示结果却为1.00000000000001,再继续运行下去的话,会出现累计现象,从而影响结果的正确性。参数的精度我都定义为双精度的,这是怎么一个情况?
回复此楼

» 猜你喜欢

» 本主题相关价值贴推荐,对您同样有帮助:

已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

★ ★
小木虫(金币+0.5):给个红包,谢谢回帖交流
余泽成(金币+1):谢谢参与应助! 2010-09-14 16:02:06
曾经电工(金币+5):谢谢您的帮助! 2010-09-14 16:07:21
曾经电工: 回帖置顶 2011-12-06 09:50:19
第一个问题,无源码无真相。

第二个问题,基本上不用担心,所有的浮点计算都有一定的误差,但这点误差基本上可以忽略不计,我想
2楼2010-09-14 14:20:36
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

曾经电工

金虫 (小有名气)

引用回帖:
Originally posted by snoopyzhao at 2010-09-14 14:20:36:
第一个问题,无源码无真相。

第二个问题,基本上不用担心,所有的浮点计算都有一定的误差,但这点误差基本上可以忽略不计,我想

谢谢您的回答,我的浓度计算程序如下,麻烦您帮我看一下是否是程序中的问题呢?我认为这种浮点计算的误差是在积累,最后都影响到结果的正确性了。
module const
implicit none
integer,parameter :: N=100                                
integer,parameter :: L=50                     
integer,parameter :: tmax=900000               
double precision,parameter :: Dis=2.0d-3              
double precision,parameter :: dx=4.0d-6            
double precision,parameter :: Ds=1.68d-9            
double precision,parameter :: Cs0=10.8d0           
double precision,parameter :: Cxm=20.0d0            
double precision,parameter :: Yxs=0.61d0            
double precision,parameter :: Ks=5.204d0              
double precision,parameter :: dts=1.0d0              
end module const


!=====================================
!              主程序
!=====================================
     program main
         use const
     implicit none
         integer :: it,x,z,ci(1:N,1:L)
         double precision :: Sd(1:N,1:L),Cd(1:N,1:L)
         
         call init_Field(Sd,Cd,ci)
         
         do it=1,tmax
         
        call substrate(Sd,Cd,ci)
        
     end do
   
    stop
        end

      subroutine init_Field(Sd,Cd,ci)
      use const
      implicit none
      double precision :: a,Sd(1:N,1:L),Cd(1:N,1:L)  
      integer :: ci(1:N,1:L)
          integer :: x,z
      
          do x=1,N
             do z=1,L
                    ci(x,z)=0
                Sd(x,z)=1.0d0
                Cd(x,z)=0.0d0
         end do
          end do

          call random_seed()
          do x=1,N
         z=1
                 call random_number(a)
         Cd(x,z)=a
         if (Cd(x,z)<=0.5d0) then
                ci(x,z)=1         
         else
                    Cd(x,z)=0.0d0
                 end if
      end do
                  
      return
      end
!=========================================================================================
! 浓度场迭代计算: 在每个坐标方向上分别采用追赶法进行求解三对角方程组,
! 其他方向则按照显示处理的交替方向隐式方法ADI(alternating direction implicit)
!=========================================================================================
          subroutine substrate(Sd,Cd,ci)
          use const
          implicit none
          integer :: x,z,ci(1:N,1:L),Zm,Zb,k(1:L)
          double precision :: Sd(1:N,1:L),Cd(1:N,1:L),Ud(1:N,1:L),Md(1:N,1:L),a1(1:N,1:L),a2(1:N,1:L),a3(1:N,1:L),aa1(1:N,1:L),aa2(1:N,1:L),aa3(1:N,1:L)  ! a1,a2,a3,b1为三对角阵方程系数(x方向);ps为底物消耗量
      double precision :: ps2(1:N,1:L),f(1:N,1:L),fe(1:N,1:L),y(1:N,1:L),m(1:N,1:L),me(1:N,1:L),r(1:N,1:L),tt,kk,I,b1(1:N,1:L),b2(1:N,1:L),ps1(1:N,1:L)
          double precision :: um,ms
          
          ms=0.562137d0
      um=0.25986d0
          Zm=0
          k(1:L)=0
          do z=1,L
             do x=1,N
                    k(z)=k(z)+ci(x,z)
                 end do
                 if (k(z)==0) then
                        Zm=z-1
                        goto 300
                 else
                    continue
                 end if
           end do
          
300   Zb=Zm+10
      
          do x=1,N
             do z=Zb+1,L
                    Sd(x,z)=1.0d0
                 end do
          end do
          
          do x=1,N
             do z=1,L
                    Ud(x,z)=Sd(x,z)
                 end do
          end do
          
          
          !!! X-direction
          tt=um
          kk=ms
          a1(1:N,1:Zb)=-1.0d0
          a3(1:N,1:Zb)=-1.0d0
          a2(1:N,1:Zb)=2.0d0+(2.0d0*(Dis**2)*(dx**2))/(dts*Ds)
          do z=2,Zb
             do x=2,N-1
                    b1(x,z)=Sd(x,z+1)+((2.0d0*(Dis**2)*(dx**2))/(dts*Ds)-2.0d0)*Sd(x,z)+Sd(x,z-1)-ps1(x,z)
                        ps1(x,z)=((Dis**2)*(dx**2)/Ds)*((tt*Cxm*Cd(x,z)*Sd(x,z))/(Yxs*Cs0*(Ks/Cs0+Sd(x,z)))+Cxm*Cd(x,z)*kk/Cs0)
                 end do
          end do
          
                                                 
    do z=2,Zb
           f(2,z)=a3(2,z)/a2(2,z)
           fe(2,z)=a2(2,z)
            do x=3,N-2
                   fe(x,z)=a2(x,z)-(a1(x,z)*f(x-1,z))
                   f(x,z)=a3(x,z)/fe(x,z)
            end do
                fe(N-1,z)=a2(N-1,z)-(a1(N-1,z)*f(N-2,z))
!----------------------------------------------------------
            y(2,z)=(b1(2,z)-a1(2,z)*Sd(1,z))/a2(2,z)                        
                do x=3,N-2
                   y(x,z)=(b1(x,z)-a1(x,z)*y(x-1,z))/fe(x,z)
                end do
        y(N-1,z)=(b1(N-1,z)-a3(N-1,z)*Sd(N,z)-a1(N-1,z)*y(N-2,z))/fe(N-1,z)
!----------------------------------------------------------
                Ud(N-1,z)=y(N-1,z)
                do x=N-2,2,-1
                   Ud(x,z)=y(x,z)-f(x,z)*Ud(x+1,z)
        end do
!-----------------------------------------------------------
                Ud(N,z)=(4.0d0*Ud(2,z)+4.0d0*Ud(N-1,z)-Ud(N-2,z)-Ud(3,z))/6.0d0
                Ud(1,z)=Ud(N,z)
        end do
   
        do x=1,N
           Ud(x,1)=(4.0d0*Ud(x,2)-Ud(x,3))/3.0d0
       Ud(1,1)=Ud(N,1)
    end do
       
        do x=1,N
           do z=1,L
              Md(x,z)=Ud(x,z)
           end do
        end do

        

      !!! Z-direction
      aa1(1:N,1:Zb)=-1.0d0
          aa3(1:N,1:Zb)=-1.0d0
          aa2(1:N,1:Zb)=2.0d0+(2.0d0*(Dis**2)*(dx**2))/(dts*Ds)
          do x=2,N-1
             do z=2,Zb
                    b2(x,z)=Md(x+1,z)+((2.0d0*(Dis**2)*(dx**2))/(dts*Ds)-2.0d0)*Md(x,z)+Md(x-1,z)-ps2(x,z)
                        ps2(x,z)=((Dis**2)*(dx**2)/Ds)*((tt*Cxm*Cd(x,z)*Md(x,z))/(Yxs*Cs0*(Ks/Cs0+Md(x,z)))+Cxm*Cd(x,z)*kk/Cs0)
         end do
          end do
          
             do x=2,N-1      
                m(x,2)=aa3(x,2)/aa2(x,2)
                me(x,2)=aa2(x,2)
            do z=3,Zb-1   
                       me(x,z)=aa2(x,z)-(aa1(x,z)*m(x,z-1))
                       m(x,z)=aa3(x,z)/me(x,z)
                end do
                        me(x,Zb)=aa2(x,Zb)-(aa1(x,Zb)*m(x,Zb-1))
!------------------------------------------------------------------------------------
                    r(x,2)=(b2(x,2)-aa1(x,2)*Md(x,1))/aa2(x,2)
                        do z=3,Zb-1
                           r(x,z)=(b2(x,z)-aa1(x,z)*r(x,z-1))/me(x,z)
                        end do
            r(x,Zb)=(b2(x,Zb)-aa3(x,Zb)*Md(x,Zb+1)-aa1(x,Zb)*r(x,Zb-1))/me(x,Zb)
!-----------------------------------------------------------------------------------
                        Sd(x,Zb)=r(x,Zb)
                        do z=Zb-1,2,-1
                       sd(x,z)=r(x,z)-m(x,z)*Sd(x,z+1)
            end do
!-----------------------------------------------------------------------------------
                        Sd(x,1)=(4.0d0*Sd(x,2)-Sd(x,3))/3.0d0
             end do
                 do z=1,Zb
                    Sd(N,z)=(4.0d0*Sd(N-1,z)+4.0d0*Sd(2,z)-Sd(3,z)-Sd(N-2,z))/6.0d0
                        Sd(1,z)=Sd(N,z)
                 end do
         
         return
             end

[ Last edited by 曾经电工 on 2010-9-14 at 16:13 ]
3楼2010-09-14 16:04:57
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

你这个程序的输出在哪里呢?
4楼2010-09-14 19:54:31
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

曾经电工

金虫 (小有名气)

输出的话,我可以在主程序里面加入的:
program main
         use const
     implicit none
         integer :: it,x,z,ci(1:N,1:L)
         double precision :: Sd(1:N,1:L),Cd(1:N,1:L)
         
         call init_Field(Sd,Cd,ci)
         
         do it=1,tmax
         
        call substrate(Sd,Cd,ci)
        do x=1,N
                   do z=1,L
                      write(*,*) x,z,Sd(x,z)
                   end do
                end do
     end do
   
    stop
        end
5楼2010-09-15 08:35:07
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

zyj8119

木虫 (著名写手)


曾经电工(金币+1):谢谢参与
曾经电工(金币+5):谢谢您的帮助! 2010-11-10 08:21:13
引用回帖:
Originally posted by 曾经电工 at 2010-09-14 16:04:57:

谢谢您的回答,我的浓度计算程序如下,麻烦您帮我看一下是否是程序中的问题呢?我认为这种浮点计算的误差是在积累,最后都影响到结果的正确性了。
module const
implicit none
integer,parameter :: N=100   ...

我觉得你最好在程序里面打开一个文件,然后把所有的数据都存放在文件中,我用CVF6.6运行你的程序什么东西都没有。
好好学习,天天向上。
6楼2010-11-09 19:53:29
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 曾经电工 的主题更新
普通表情 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 274求调剂求调剂 +3 Jachenbingoo 2026-04-06 3/150 2026-04-06 15:22 by lin-da
[考研] 070300化学279求调剂 +16 哈哈哈^_^ 2026-03-31 19/950 2026-04-06 14:14 by 无际的草原
[考研] 265求调剂 +7 小木虫085600 2026-04-06 7/350 2026-04-06 14:12 by 蒋皓禹
[考研] 304求调剂(085602,过四级,一志愿985) +15 化工人999 2026-04-04 15/750 2026-04-05 16:25 by 我是电风扇r
[考研] 324求调剂 +9 想上学求调 2026-04-03 9/450 2026-04-04 23:57 by 果冻大王
[考研] 282电子信息0854专硕调剂 +4 202451007219 2026-04-02 6/300 2026-04-04 21:55 by laoshidan
[考研] 293分求调剂,外语为俄语 +6 加一一九 2026-03-31 6/300 2026-04-04 14:57 by 聪明的大松鼠
[考研] 278求调剂 +6 Yy7400 2026-04-03 6/300 2026-04-04 09:53 by zhangdingwa
[考研] 335求调剂 +7 沈清璃 2026-04-03 7/350 2026-04-03 18:55 by lijunpoly
[考研] 301求调剂 +14 A_JiXing 2026-04-01 14/700 2026-04-03 18:31 by ls刘帅
[考研] 289-求调剂 +4 这里是_ 2026-04-03 4/200 2026-04-03 14:23 by 1753564080
[考研] 302求调剂 +9 zyx上岸! 2026-04-02 9/450 2026-04-02 23:07 by 马儿快快地跑
[考研] 交通运输考试264分求工科调剂 +4 jike777 2026-04-02 4/200 2026-04-02 21:53 by zllcz
[考研] 一志愿北京科技大学085601材料工程英一数二初试总分335求调剂 +8 双马尾痞老板2 2026-04-02 9/450 2026-04-02 14:45 by 5896
[考研] 初试301,代码085701环境工程,本硕一致,四六级已过,有二区一作,共发表5篇论文 +6 axibli 2026-04-01 6/300 2026-04-02 13:42 by Ecowxq666!
[考研] 298求B区调剂 +4 zzz,,r 2026-04-02 5/250 2026-04-02 12:17 by 土木硕士招生
[考研] 270调剂 +7 maxjxbsk 2026-04-02 7/350 2026-04-02 09:50 by yulian1987
[考研] 262求调剂 +9 励志一定发文章 2026-03-31 10/500 2026-04-01 12:22 by sunshine0013
[考研] 340求调剂 +4 希望如此i 2026-03-31 4/200 2026-03-31 16:40 by 690616278
[考研] 313求调剂 +6 卖个关子吧 2026-03-31 6/300 2026-03-31 10:58 by Jaylen.
信息提示
请填处理意见