大神给改改这个代码吧，错误挺多，谢了-Fortran语法讨论-专业Fortran论坛

聂彪66 发表于 2016-9-29 20:45:29

大神给改改这个代码吧，错误挺多，谢了

program zuhe
   parameter(aa1=0.005,aa2=100,bb1=0.02,bb2=400,cc1=0.08,cc2=700, &
   dd1=0.06,dd2=200,d1=100,d2=300,s=50.26,L0=461,fd=7000)
   real i

   st=0.00001
   et=30
   k1=aa2/aa1
   k2=(cc2-bb2)/(cc1-bb1)
   k3=(dd2-cc1)/(dd1-cc1)
   k4=(aa2-dd2)/(aa1-dd1)
   pp1=log((2*SQRT(d2*d2*(SIN(2*3.14/8))**2+(d2*COS(2*3.14/8)-d1)**2))/LO)
   pp2=bb2+k2*(pp1-bb1)
   do 100i=0.0,30.0,0.025
   k=floor(MOD(i,1.0),0.25)+1
   fdd=(floor(i,1))*fd+fd
   if(k.eq.1)then
   f=MOD(i,1/4)*fdd*4/1
   elseif(k.eq.2)then
   f=fdd-MOD(i,1/4)*fdd*4/1
   elseif(k.eq.3)then
   f=-MOD(i,1/4)*fdd*4/1
   else
   f=-(fdd-MOD(i,1/4)*fdd*4/1)
   endif
   If ((step / et).lt.0 )Then
   et = -et
   End If
   if((floor(i,(1/4))+1).lt.9)then
   k5=floor(i,(1/4))+1
   else
   k5=floor(mod(i,1),(1/4))+5
   endif
   if(mod(i,(1/4)).eq.0)then
   k5=k5-1
   endif
   if(k5.eq.0)then
      k5=k5+1
   endif
   IF(MOD(i,(1/4)).eq.0)then
      k6=k-1
      else
      k6=k
   endif
   if(k6.eq.0)then
      k6=k6+1
   endif


   if((k5.eq.1).or.(k5.eq.4).or.(k5.eq.5).or.(k5.eq.8))then
      step=0.5
      else
      step=-0.5
   endif

   do 200 x=st,et,step

   CALL silk1(x,d1,d2,s1,a1,b1,c1,d1,e1,f1,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk2(x,d1,d2,s2,a2,b2,c2,d2,e2,f2,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk3(x,d1,d2,s3,a3,b3,c3,d3,e3,f3,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk4(x,d1,d2,s4,a4,b4,c4,d4,e4,f4,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk5(x,d1,d2,s5,a5,b5,c5,d5,e5,f5,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk6(x,d1,d2,s6,a6,b6,c6,d6,e6,f6,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk7(x,d1,d2,s7,a7,b7,c7,d7,e7,f7,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk8(x,d1,d2,s8,a8,b8,c8,d8,e8,f8,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk9(x,d1,d2,s9,a9,b9,c9,d9,e9,f9,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk10(x,d1,d2,s10,a10,b10,c10,d10,e10,f10,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk11(x,d1,d2,s11,a11,b11,c11,d11,e11,f11,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk12(x,d1,d2,s12,a12,b12,c12,d12,e12,f12,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk13(x,d1,d2,s13,a13,b13,c13,d13,e13,f13,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk14(x,d1,d2,s14,a14,b14,c14,d14,e14,f14,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk15(x,d1,d2,s15,a15,b15,c15,d15,e15,f15,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk16(x,d1,d2,s16,a16,b16,c16,d16,e16,f16,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   fx=fx1+fx2+fx3+fx4+fx5+fx6+fx7+fx8+fx9+fx10+fx11+fx12+fx13+fx14+fx15+fx16
   if((k6.eq.1).and.(k6.eq.4))then
   if(fx.gt.f)then
      zx=aa
      zd=x
      do 10 until (abs((fx-f).lt.0.1))
         If ((abs(zd - zx) .lt. 0.00001)) Exit
      if(fx.gt.f)then
            zd=x
            else
            zx=x
      endif
      x=(zd+zx)/2
      CALL silk1(x,d1,d2,s1,a1,b1,c1,d1,e1,f1,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk2(x,d1,d2,s2,a2,b2,c2,d2,e2,f2,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk3(x,d1,d2,s3,a3,b3,c3,d3,e3,f3,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk4(x,d1,d2,s4,a4,b4,c4,d4,e4,f4,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk5(x,d1,d2,s5,a5,b5,c5,d5,e5,f5,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk6(x,d1,d2,s6,a6,b6,c6,d6,e6,f6,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk7(x,d1,d2,s7,a7,b7,c7,d7,e7,f7,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk8(x,d1,d2,s8,a8,b8,c8,d8,e8,f8,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk9(x,d1,d2,s9,a9,b9,c9,d9,e9,f9,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk10(x,d1,d2,s10,a10,b10,c10,d10,e10,f10,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk11(x,d1,d2,s11,a11,b11,c11,d11,e11,f11,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk12(x,d1,d2,s12,a12,b12,c12,d12,e12,f12,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk13(x,d1,d2,s13,a13,b13,c13,d13,e13,f13,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk14(x,d1,d2,s14,a14,b14,c14,d14,e14,f14,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk15(x,d1,d2,s15,a15,b15,c15,d15,e15,f15,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk16(x,d1,d2,s16,a16,b16,c16,d16,e16,f16,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   fx=fx1+fx2+fx3+fx4+fx5+fx6+fx7+fx8+fx9+fx10+fx11+fx12+fx13+fx14+fx15+fx16
10 continue
   st=x
   exit
   else
   aa=x
      endif
   else
   if(fx.lt.f)then
      zd=aa
      zx=x
      do until (abs((fx-f).lt.0.1))
         If ((abs(zd- zx) .lt. 0.00001)) Exit
      if(fx.lt.f)then
            zx=x
            else
            zd=x
      endif
      x=(zd+zx)/2
      CALL silk1(x,d1,d2,s1,a1,b1,c1,d1,e1,f1,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk2(x,d1,d2,s2,a2,b2,c2,d2,e2,f2,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk3(x,d1,d2,s3,a3,b3,c3,d3,e3,f3,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk4(x,d1,d2,s4,a4,b4,c4,d4,e4,f4,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk5(x,d1,d2,s5,a5,b5,c5,d5,e5,f5,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk6(x,d1,d2,s6,a6,b6,c6,d6,e6,f6,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk7(x,d1,d2,s7,a7,b7,c7,d7,e7,f7,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk8(x,d1,d2,s8,a8,b8,c8,d8,e8,f8,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk9(x,d1,d2,s9,a9,b9,c9,d9,e9,f9,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk10(x,d1,d2,s10,a10,b10,c10,d10,e10,f10,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk11(x,d1,d2,s11,a11,b11,c11,d11,e11,f11,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk12(x,d1,d2,s12,a12,b12,c12,d12,e12,f12,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk13(x,d1,d2,s13,a13,b13,c13,d13,e13,f13,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk14(x,d1,d2,s14,a14,b14,c14,d14,e14,f14,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk15(x,d1,d2,s15,a15,b15,c15,d15,e15,f15,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   CALL silk16(x,d1,d2,s16,a16,b16,c16,d16,e16,f16,pp1,pp2,aa1,aa2,bb1,bb2,cc1,cc2,dd1,dd2,k5,k1,k2,k3,k4,f1,fx1,L0)
   fx=fx1+fx2+fx3+fx4+fx5+fx6+fx7+fx8+fx9+fx10+fx11+fx12+fx13+fx14+fx15+fx16
20 continue
   st=x
   exit
   else
   aa=x
   endif
   endif
200 continue
100 continue
      end

聂彪66 发表于 2016-9-29 20:49:08

Compiling .\zuhe2.f90
.\zuhe2.f90:4.11:

   real
      1
Error: Invalid character in name at (1)
.\zuhe2.f90:79.11:

      do 10 until (abs((fx-f).lt.0.1))
      1
Error: Unclassifiable statement at (1)
.\zuhe2.f90:86.22:

      x=(zd+zx)/2
                  1
.\zuhe2.f90:56.25:

   do 200 x=st,et,step
                     2
Error: Variable 'x' at (1) cannot be redefined inside loop beginning at (2)
.\zuhe2.f90:114.11:

      do 20 until (abs((fx-f).lt.0.1))
      1
Error: Unclassifiable statement at (1)
.\zuhe2.f90:121.22:

      x=(zd+zx)/2
                  1
.\zuhe2.f90:56.25:

   do 200 x=st,et,step
                     2
Error: Variable 'x' at (1) cannot be redefined inside loop beginning at (2)
.\zuhe2.f90:15.20:

   k=floor(MOD(i,1.0),(1.0/4.0))+1
               1
Error: 'a' and 'p' arguments of 'mod' intrinsic at (1) must have the same type
.\zuhe2.f90:16.17:

   fdd=(floor(i,1))*fd+fd
            1
Error: 'a' argument of 'floor' intrinsic at (1) must be REAL
.\zuhe2.f90:29.16:

   if((floor(i,(1/4))+1).lt.9)then
            1
Error: 'a' argument of 'floor' intrinsic at (1) must be REAL
.\zuhe2.f90:30.16:

   k5=floor(i,(1/4))+1
            1
Error: 'a' argument of 'floor' intrinsic at (1) must be REAL
.\zuhe2.f90:32.16:

   k5=floor(mod(i,1),(1/4))+5
            1
Error: 'a' argument of 'floor' intrinsic at (1) must be REAL
.\zuhe2.f90:56.12:

   do 200 x=st,et,step
         1
Error: Deleted feature: Loop variable at (1) must be integer
.\zuhe2.f90:14.21:

   do 100i=0,30,0.025
                  1
Error: Deleted feature: Step expression in DO loop at (1) must be integer
Error(E42): Last command making (build\zuhe2.o) returned a bad status
Error(E02): Make execution terminated

* Failed *
这是错误提示

pasuka 发表于 2016-9-29 21:10:03

聂彪66 发表于 2016-9-29 20:49
Compiling .\zuhe2.f90
.\zuhe2.f90:4.11:

对照理论公式或者推导，用F90重写吧，这类古董级史前Fortran 代码就甭留恋了，火候到位的话，代码行数可以减小一个数量级

聂彪66 发表于 2016-9-29 21:16:52

pasuka 发表于 2016-9-29 21:10
对照理论公式或者推导，用F90重写吧，这类古董级史前Fortran 代码就甭留恋了，火候到位的话，代码行数可 ...

大神，小的刚学的，实在不会啊，而且老师要求的急，大神能不能帮忙改改，而且f90也没有看过，图书馆的书全是f77的。

fcode 发表于 2016-9-30 10:37:06

这代码的问题：
1. 太古老了。until 这种用法，我这里没有一个编译器支持的。fortran 只有 do while 没有 do until ，我也不知道应该如何修改它。
2. 错误太多，根本没有办法修改或运行。比如说
a. do 100i=0.0,30.0,0.025 do 循环的循环变量 i 应该是 integer，如果用 real 当做循环变量，后果可能会非常的严重。
b. f=MOD(i,1/4)*fdd*4/1 既然 i 是 real 类型，那么对于 mod 函数来说，两个参数的类型必须一致。所以 1/4 也必须是 real 类型才可以。
c.floor(MOD(i,1.0),0.25) 这里的 floor 函数，第二个参数是 0.25！！！它表示 kind 值啊，只能是整数，哪个编译器支持 kind 为 0.25 的数据？？
d . 1/4 = 0 !!!! 这很可怕。程序代码里到处都是 1/4，而结果却是 0 ，我相信这代码就算运行了，结果也肯定与作者的想法相去甚远。
3. 没有用 implicit none
4. 一大堆 d1,d2,s4,a4,b4,c4,d4,e4,f4 这种变量，为什么不用数组？
5. 一大堆 silk1 ,silk2,silk3.....silk16 这种子程序，真的需要这么多过程？这些过程能否统一？如果不能，为何不取更有意义的名称？

聂彪66 发表于 2016-9-30 10:52:39

fcode 发表于 2016-9-30 10:37
这代码的问题：
1. 太古老了。until 这种用法，我这里没有一个编译器支持的。fortran 只有 do while 没有 d ...

大神的回答就是专业，我是刚刚学的，不是很懂，望大神谅解，b,c,d，，我度理解了，但是a 就不知道了，那i要实数怎么办呢

pasuka 发表于 2016-9-30 11:01:29

聂彪66 发表于 2016-9-29 21:16
大神，小的刚学的，实在不会啊，而且老师要求的急，大神能不能帮忙改改，而且f90也没有看过，图书馆的书 ...

跟着这样不负责任的所谓“导师”读研，lz的苦日子还在后头哩

聂彪66 发表于 2016-9-30 11:11:05

pasuka 发表于 2016-9-30 11:01
跟着这样不负责任的所谓“导师”读研，lz的苦日子还在后头哩

额。不是了，我不是专业的，老师就是让算一个东西用到这个，我肯定要学咯，开始肯定度不懂，跟导师没关系吧，总之谢了啊

pasuka 发表于 2016-10-2 09:00:38

聂彪66 发表于 2016-9-30 11:11
额。不是了，我不是专业的，老师就是让算一个东西用到这个，我肯定要学咯，开始肯定度不懂，跟导师没关系 ...

这样的老师随手扔给学生一个自己都很多年不用更新维护的旧代码，使用文档、理论手册一概没有，也不能亲自指导学生编译调试，这样不负责任当然能撇清一切关系喽。。。

页: [1]

Fortran Coder's Archiver

大神给改改这个代码吧，错误挺多，谢了