24小时热门版块排行榜    

查看: 2280  |  回复: 1

hznu2007

铁虫 (初入文坛)

[求助] FORTRAN程序DO WHILE出现语句错误,请哪位高手修改一下(紧急求助) 已有1人参与

program main
  use IMSL
  implicit none
  external FCN
  
  real, parameter :: ERRREL=0.0001
  integer, parameter :: N=2
  integer, parameter :: ITMAX=100
  real :: XGUESS(N)=(/ 0.5, 0.5 /)
  real X(N) , FNORM

  CALL NEQNF(FCN, ERRREL, N, ITMAX, XGUESS, X, FNORM)
  write(*,*) X
  stop
end

subroutine FCN(XA, F, N)
   implicit none
   integer N
   external FK, FE
   double precision a, b, c, Romberg
   real, target :: XA(N)
   real F(N)
   real, pointer :: x, ita
   x=> XA(1)
   ita=> XA(2)
  
   c=Romberg(a, b, ita, FK)
   F(1)=2*c/3.14159265+0.5/sqrt(1-ita**2)-0.5
   c=Romberg(a, b, ita, FE)
   F(2)=2*c/3.14159265+0.5*sqrt(1-ita**2)-2.5+x*(ita**2)
   
   return
end subroutine

double precision function FE(g,ita)
  double precision g, ita
  FE=( 1-(ita*cos(g))*(ita*cos(g))) **0.5
end


double precision function FK(g,ita)
  double precision g, ita
  FK=( 1-(ita*cos(g))*(ita*cos(g))) **0.5
  FK=1/FK
end

double precision function Romberg(a, b, ita, f)
  double precision a, b, ita, f, eps
  integer m, i, k, point
  parameter(m=30, eps=1e-9)
  double precision t(m), er, h, tt, t2, l

  h=b-a
  k=1
  er=1
  point=1
  t(1)=h/2*(f(a,ita)+f(b,ita))

    do 10 while( (er.gt.eps).and.(k.lt.n))
       tt=t(1)

           t(1)=0
           do 20 i=1,point
           t(1)=t(1)+f(a+i*h-h/2,ita)
           continue
           t(1)=tt/2+t(1)*h/2

           l=1
           do 30 i=2,k
             t2=t(i)
                 l=l*4
                 t(i)=(t(i-1)*l-tt)/(l-1)
                 tt=t2
           continue

           point=point*2
           k=k+1
           h=h/2
           l=l*4
           t(k)=(t(k-1)*1-tt)/(l-1)
           er=abs(t(k)-tt)

         continue
         Romberg=t(k)
   end do
  
end
--------------------Configuration: 201401 - Win32 Debug--------------------
Compiling Fortran...
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(70) : Error: This DO variable has already been used as an outer DO variable in the same nesting structure.   [I]
    do 30 i=2,k
-----------------^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(86) : Error: This ENDDO statement requires a label.   [30]
   end do
^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(70) : Error: There is an extra DO construct label.   [30]
    do 30 i=2,k
--------------^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(64) : Error: An unterminated block exists.
    do 20 i=1,point
^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(60) : Error: An unterminated block exists.
    do 10 while( (er.gt.eps).and.(k.lt.n))
^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(60) : Error: This label is undefined.   [10]
    do 10 while( (er.gt.eps).and.(k.lt.n))
-------^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(64) : Error: This label is undefined.   [20]
    do 20 i=1,point
--------------^
Error executing df.exe.

01.obj - 7 error(s), 0 warning(s)
回复此楼

» 猜你喜欢

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

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

jpchou

专家顾问 (著名写手)

【答案】应助回帖


感谢参与,应助指数 +1
jjdg: 金币+1, 感谢参与 2014-01-14 01:49:13
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(70) : Error: This DO variable has already been used as an outer DO variable in the same nesting structure.   [I]
    do 30 i=2,k
-----------------^
D:\compaq visual fortran\MSDEV98\MyProjects\hello\01.f90(86) : Error: This ENDDO statement requires a label.   [30]
   end do
^

你 do 30 i=2,k 給了個 label "30"
可是 end do 忘了給
把 end do 改成 30 end do
就可以
其他地方也要做同樣的修改
2楼2014-01-13 20:23:47
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 hznu2007 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[基金申请] 让我中一个面上吧! +5 大萍1987 2026-08-20 5/250 2026-08-20 20:46 by RRRKKK
[基金申请] 时间戳又变了 +12 wuchongjun 2026-08-20 17/850 2026-08-20 20:05 by spzhao
[基金申请] 今天系统多次维护,明天很可能放榜! +10 zju2000 2026-08-16 11/550 2026-08-20 20:02 by cl479861084
[基金申请] 时间戳变了,能看出什么问题? +18 基诺咪客 2026-08-17 23/1150 2026-08-20 17:19 by Godzela
[基金申请] 只有每年这种时候来逛逛小木虫 +21 yaoyewhu2008 2026-08-20 22/1100 2026-08-20 17:03 by yaoyewhu2008
[基金申请] 放榜前的不淡定 40+3 snowwithsea 2026-08-19 12/600 2026-08-20 15:56 by lfy8008
[基金申请] 重要消息,中午系统在维护 +11 yuleib84 2026-08-18 12/600 2026-08-20 11:09 by xskun
[基金申请] 今天基金会出结果吗?20260819 +14 kkkl_v 2026-08-19 15/750 2026-08-20 08:21 by sunzitan
[基金申请] filecode,4个jtjc了 +11 ziyangfang 2026-08-19 13/650 2026-08-19 21:28 by aasahr
[基金申请] 今天放榜没戏了吧 +4 yuleib84 2026-08-19 5/250 2026-08-19 19:52 by hhs666
[基金申请] 今天放榜吗? +14 布布和一二 2026-08-19 15/750 2026-08-19 18:07 by gltch
[基金申请] filecode=后面第一个是大写字母 +10 wangze12014 2026-08-14 12/600 2026-08-19 16:56 by 苦难博士
[基金申请] 2027广东省杰青 +4 奶牛小黑 2026-08-15 10/500 2026-08-19 11:02 by wanfengnew
[基金申请] 朋友圈看到的 +6 wangzilk 2026-08-18 8/400 2026-08-19 10:55 by Haru815
[基金申请] 快农历七夕节了,轻松一下,男人悄悄话,女施主请不要进来。 +6 Tide man 2026-08-14 7/350 2026-08-19 09:56 by ZJTJZ
[基金申请] 明天放榜? +5 Shxjjxjkx 2026-08-18 5/250 2026-08-18 18:14 by -大大大大大-
[基金申请] 时间戳又变了8-15 +14 archvillain 2026-08-15 26/1300 2026-08-18 13:37 by phantomgost
[基金申请] 今天维护系统维护 祝所有人 高中 +8 gjjjzhong 2026-08-18 9/450 2026-08-18 13:01 by 家与远方
[精细化工] 招聘 金属平磨液,抛光液研发工程师 +3 小天0311 2026-08-14 3/150 2026-08-16 07:31 by H9PLUS
[基金申请] 各位道友,我要去昆明玩几天,回来见。 +7 Tide man 2026-08-14 8/400 2026-08-15 01:11 by arzu_hma
信息提示
请填处理意见