24小时热门版块排行榜    

查看: 595  |  回复: 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的回帖
相关版块跳转 我要订阅楼主 虫子精神 的主题更新
信息提示
请填处理意见