24小时热门版块排行榜    

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

虫子精神

新虫 (初入文坛)

[求助] 程序出现错误 请大家帮忙解决 谢谢! 已有1人参与

This program is used to the Elastic-Plastic Waves in one-dimensional rods.
      parameter(ke=1000,nmax=900)
        dimension s(ke),u(ke),e(ke),f(ke),mf(ke)
        real time(0:nmax),xl(nmax),xr(nmax)
        real sr(0:ke),ur(0:ke),st(3),ut(3),ft(2)

ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      rh0=1.0
        c0=1.0
        fk0=1.0
        en=1.3
        dx=0.01
        dt=dx/c0
        do 10 k=1,ke
        s(k)=0.
      u(k)=0.
      e(k)=0.
      f(k)=fk0
      mf(k)=0.
10    continue
      time(0)=0.
        do 900 n=1,nmax
        write(*,*)'n=',n

ccccccccccccccccccRiemann problem for flux  cccccccccccccccccccccccccccccccccccccccccccccccccc
      do 100 k=1,ke-1
        st(1)=s(k)
        ut(1)=u(k)
        ft(1)=f(k)
        st(2)=s(k+1)
        ut(2)=u(k+1)
        ft(2)=f(k+1)
        call riem(st,ut,ft)
      sr(k)=st(3)
        ur(k)=ut(3)
100   continue

cccccccccccccccccccleft boundary condition  ccccccccccccccccccc
      call left(n,dt,simpt)
        sr(0)=simpt
      ur(0)=u(1)+dt/(rh0*dx)*(s(1)-simpt)

cccccccccccccccc right boundary condition cccccccccccccccccccccc
      sr(ke)=0.
        ur(ke)=u(ke)+dt/(rh0*dx)*(0.-s(ke))

cccccccccccccc updating ccccccccccccccccccccccccccccccccccccccccccc
      time(n)=time(n-1)+dt
        do 200 k=1,ke
        u(k)=u(k)+dt/(rh0*dx)*(sr(k)-sr(k-1))
        de=dt/dx*(ur(k)-ur(k-1))
        e(k)=e(k)+de
        sig=s(k)+rh0*c0*c0*de
        if (abs(sig).lt.f(k))then
        s(k)=sig
        test=(f(k)-abs(sig))/fk0
        if((mf(k).eq.1).and.(test.gt.0.05)) then
        mf(k)=2
        goto 200
        end if
        sa=f(k)
        if(sig.lt.0) then
      sa=-sa
        de1=de-(sa-s(k))/(rh0*c0*c0)
        nk=5.+abs(de1)*rh0*c0*c0/fk0*200
        dde=de1/float(nk)
        do 150 i=1,nk
        ff=abs(sa)
        ep=en*rh0*c0*c0*(ff/fk0)**(1.-1./en)
        sa=sa+ep*dde
150   continue
      s(k)=sa
        f(k)=abs(sa)
        if((mf(k).eq.0).and.((f(k)/fk0).gt.1.01)) then
        mf(k)=1
200   continue
      xl(n)=0.
        xr(n)=0.
        do 300 k=1,ke
        if(mf(k).eq.2) xl(n)=k*dx
      if(mf(k).eq.1) xr(n)=(k-1.)*dx
300   continue
      
        if((n.eq.200).or.(n.eq.240).or.(n.eq.400))then
        nput=n/10
        write(nput,*)'one-dimensional rod problem'
        write(nput,*)'stress distribution as t=',time(n)
        do 950 k=1,350,4
        write(nput,1100) (k-0.5)*dx,-s(k)
950   continue
      end if
900   continue
      write(12,*)'elastic-plastic boundary,loading,0.01'
      write(14,*)'elastic-plastic boundary,unloading,0.05'
        do 910 n=1,nmax,10
        if(x1(n).gt.0.03) write(14,1100) x1(n),time(n)
      if(xr(n).gt.0.03) write(12,1100) xr(n),time(n)
910   continue
1100  format(2f7.3,'*100')
      end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

      subroutine riem(s,u,f)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c     a subroutine for solving Riemann problem
c     The output is the second-order flux
      real s(3),u(3),f(2),ss(2,1010),cc(2,1010)
        dimension nn(1010)
ccccccccccccccccwhen CFL=1,CO=dx/dt ccccccccccccccccccccc
      u(3)=(u(1)+u(2))/2.+(s(2)-s(1))/(2.*rh0*c0)
        s(3)=(s(1)+s(2))/2.+rh0*c0*(u(2)-u(1))/2.
        sig=s(3)
      if((abs(sig).le.f(1)).and.(abs(sig).le.f(2))) return
        en1=(en-1.)/(2.*en)
1     do 200 m=1,2
      ss(m,1)=s(m)
        cc(m,1)=c0
        if(abs(sig).le.f(m))then
        ss(m,2)=sig
        cc(m,2)=c0
        nn(m)=2
        goto 200
        end if

        sa=f(m)
        if(sig.lt.0) sa=-sa
        ss(m,2)=sa
        nk=5+(abs(sig)-f(m))/fk0*200
        if(nk.gt.1000) nk=1000
        ds=(sig-sa)/float(nk)

        do 100 i=1,nk
        ss(m,i+2)=sa+float(i)*ds
        ff=abs(sa+(i-0.5)*ds)
        cc(m,i+1)=c0*sqrt(en)*(ff/fk0)**en1
100   continue

      ff=abs(ss(m,nk+2))
        cc(m,nk+2)=c0*sqrt(en)*(ff/fk0)**en1
        nn(m)=nk+2
200   continue

      sum=u(2)-u(1)
        do 310 m=1,2
        do 300 i=1,nn(m)-1
        sum=sum-(ss(m,i+1)-ss(m,i))/(rh0*cc(m,i))
300   continue
310   continue

      rr=1./(rh0*cc(1,nn(1)))+1./(rh0*cc(2,nn(2)))
        sum=sig+sum/rr
        if((abs(sum-sig)/fk0).le.1e-6) goto 500
        sig=sum
        goto 1
500   s(3)=s(1)+s(2)
      do 560 m=1,2
        do 560 i=1,nn(m)-1
        s(3)=s(3)+(cc(m,i)/c0)*(ss(m,i+1)-ss(m,i))
560   continue
      s(3)=s(3)/2
        return
        end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine left(n,dt,simpt)
ccccccccccccc  left boundary condition ccccccccccccccc
      t=float(n)*dt
        if(t.le.2.0001) then
        simpt=-3.*fk0
        else
        simpt=0.
        end if
        return
        end

出现的错误如下
Configuration: wave1D - Win32 Debug--------------------
Compiling Fortran...
E:\wave\chengxu\wave1D\wave1D.for
E:\wave\chengxu\wave1D\wave1D.for(49) : Warning: A jump into a block from outside the block has occurred.   [800]
do 800 k=1,ke
-----------^
E:\wave\chengxu\wave1D\wave1D.for(76) : Error: An unterminated If or DO statement exists.
800   continue
^
E:\wave\chengxu\wave1D\wave1D.for(76) : Error: An unterminated If or DO statement exists.
800   continue
^
E:\wave\chengxu\wave1D\wave1D.for(76) : Error: An unterminated If or DO statement exists.
800   continue
^
Error executing df.exe.

wave1D.obj - 3 error(s), 1 warning(s)
回复此楼
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

fxj126

木虫 (小有名气)

【答案】应助回帖

感谢参与,应助指数 +1
do跟if结束都要 endif enddo 建议不要写end 分开写比较清楚
2楼2016-01-22 09:49:57
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

fmying

银虫 (小有名气)

为什么就没看到你贴出的程序中有
do 800 k = 1,ke

800 continue
这两句呢?
上善若水
3楼2016-01-24 21:53:15
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 虫子精神 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 材料调剂 +12 一样YWY 2026-04-01 12/600 2026-04-02 00:21 by 百秒光年
[考研] 英一数一408,总分284,二战真诚求调剂 +12 12.27 2026-03-30 14/700 2026-04-02 00:18 by 欣喜777
[考研] 085801 总分275 本科新能源 求调剂 +10 bradoner 2026-04-01 11/550 2026-04-01 22:57 by 来看流星雨10
[考研] 【求调剂】085601材料工程专硕 | 总分272 | +10 脚滑的守法公民 2026-03-27 10/500 2026-04-01 17:23 by pies112
[考研] 314求调剂 +4 溪云珂 2026-03-26 4/200 2026-04-01 17:00 by oooqiao
[考研] 生物学学硕,一志愿湖南大学,初试成绩338 +8 YYYYYNNNNN 2026-03-26 10/500 2026-04-01 14:39 by hexingyi
[考研] 一志愿 南京航空航天大学 ,080500材料科学与工程学硕 +7 @taotao 2026-03-30 7/350 2026-04-01 14:30 by chenqifeng666
[论文投稿] chinese chemical letters英文版投稿求助 120+4 Yishengeryi 2026-03-30 5/250 2026-04-01 14:11 by 陆小果画大饼
[考研] 318求调剂 +8 七忆77 2026-04-01 8/400 2026-04-01 10:37 by Jaylen.
[考研] 求化学调剂 +12 wulanna 2026-03-28 12/600 2026-03-31 16:38 by 690616278
[考研] 263求调剂 +3 DDDDuu 2026-03-27 3/150 2026-03-31 16:21 by 土木硕士招生
[考研] 英一数一总分334求调剂 +4 陈阳坤 2026-03-31 4/200 2026-03-31 14:22 by 记事本2026
[考研] 吉大生物学326分求调剂 +3 sunnyupup 2026-03-31 3/150 2026-03-31 09:28 by longlotian
[考研] 083000环境科学与工程调剂,总分281 +4 橙子(胜意) 2026-03-30 4/200 2026-03-31 00:44 by Linzejun
[考研] 求调剂 +7 青春裁为三截 2026-03-29 7/350 2026-03-30 13:14 by laoshidan
[考研] 311求调剂 +10 lin0039 2026-03-26 10/500 2026-03-30 10:26 by herarysara
[考研] 085600,材料与化工321分求调剂 +10 大馋小子 2026-03-28 10/500 2026-03-29 23:35 by 飞行日记西
[考研] 一志愿北京工业大学,324分求调剂 +6 零八# 2026-03-28 6/300 2026-03-29 21:20 by nanaliuyun
[考研] 265求调剂 +8 小木虫085600 2026-03-27 8/400 2026-03-27 22:16 by 无际的草原
[考研] 08开头275求调剂 +4 拉谁不重要 2026-03-26 4/200 2026-03-27 14:12 by Delta2012
信息提示
请填处理意见