Fortran Coder

查看: 10333|回复: 7
打印 上一主题 下一主题

[流程控制] 各位高人请看这个程序是怎么执行的

[复制链接]

46

帖子

12

主题

0

精华

熟手

F 币
116 元
贡献
104 点
跳转到指定楼层
楼主
发表于 2014-7-17 18:30:34 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
[Fortran] 纯文本查看 复制代码

SUBROUTINE REMA(IJ,IK,II,NREF)
      implicit real*8 (a-h,o-z)
      COMMON NG,NM,NM1,NNG,NN,NMS,BA,BB,NSVC,NMG,NTCSC,NMGS
      COMMON/COMC/NGIN(165),NGOUT(165),NMIN(420),NMOUT(420),NMM(420,3)
      COMMON/COMD/BK(420),BK1(165),BK2(165),TA(165),TB(165),NPSS(10,10)
      LPSS=1
      LL=1
 1    read(2,*) N1,N2,CA,TRA,CB,TRB
      IF(N1.LT.0) THEN
   LL=LL+1
   IF(LL.LE.II) GOTO 1
   NPSS(IJ,LPSS)=-1
   RETURN
      ENDIF
      IF(TRA.EQ.0.0.and.TRB.EQ.0.0) GOTO 3
      NG=NG+1
      WRITE(3,605) NG,'G',N1+IK,N2+IK,CA,TRA,CB,TRB
 605  FORMAT(I3,7X,A1,2I5,4F15.5)
      TB(NG)=TRB
      TRB=1.0/TRB
      bk1(NG)=CA*TRB
      bk2(NG)=CB*TRB
      TA(NG)=TRA*TRB
      NGIN(NG)=N1+IK
      NGOUT(NG)=N2+IK
      GOTO 1
 3    NM=NM+1
      WRITE(3,606) NM,'M',N1+IK,N2+IK,CA,TRA,CB,TRB
 606  FORMAT(I6,4X,A1,2I5,4F15.5)
      bk(NM)=CA
      NMIN(NM)=N1+IK
      NMOUT(NM)=N2+IK
      NMM(NM,3)=0
      IF(N1.EQ.17.AND.IJ.EQ.NREF) THEN
 NM=NM-1
 GOTO 1
      ENDIF
      IF(LL.EQ.II) THEN
 NPSS(IJ,LPSS)=NM
 LPSS=LPSS+1
      ENDIF
      GOTO 1
      END

其中文件2为:
0.0025 1.8 1.7 0.3 0.55 0.25 0.25 8.0 0.4 0.03 0.05 6.5
  0.0  12.0
  8   9   -1.000    0.000    1.000    0.010
  9   7  200.000    0.000    0.000    0.000
-1 0 0 0 0 0
  5  31    10.50     0.00    1.000    0.00
31  32    0.000    10.00    1.000    10.00
32   9    1.000    0.237    1.000    0.176
-1 0 0 0 0 0
-1 0 0 0 0 0
0.0025 1.8 1.7 0.3 0.55 0.25 0.25 8.0 0.4 0.03 0.05 6.5
  0.0  12.0
  8   9   -1.000    0.000    1.000    0.010
  9   7  200.000    0.000    0.000    0.000
-1 0 0 0 0 0
  5  31     4.00     0.00    1.000    0.00
31  32    0.000    10.00    1.000    10.00
32   9    1.000    0.285    1.000    0.17
-1 0 0 0 0 0
-1 0 0 0 0 0
0.0025 1.8 1.7 0.3 0.55 0.25 0.25 8.0 0.4 0.03 0.05 6.175
  0.0  12.0
  8   9   -1.000    0.000    1.000    0.010
  9   7  200.000    0.000    0.000    0.000
-1 0 0 0 0 0
-1 0 0 0 0 0
  5  31     8.00     0.00    1.000    0.00
31  32    0.000    10.00    1.000    10.00
32   9    1.000    0.180    1.000    0.166
-1 0 0 0 0 0
0.0025 1.8 1.7 0.3 0.55 0.25 0.25 8.0 0.4 0.03 0.05 6.175
  0.0  12.0
  8   9   -1.000    0.000    1.000    0.010
  9   7  200.000    0.000    0.000    0.000
-1 0 0 0 0 0
-1 0 0 0 0 0
  5  31     8.00     0.00    1.000    0.00
31  32    0.000    10.00    1.000    10.00
32   9    1.000    0.192    1.000    0.165
-1 0 0 0 0 0
32
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

6

帖子

1

主题

0

精华

入门

F 币
74 元
贡献
53 点
沙发
发表于 2014-7-19 09:50:58 | 只看该作者
这种还不如直接重写,

46

帖子

12

主题

0

精华

熟手

F 币
116 元
贡献
104 点
板凳
 楼主| 发表于 2014-7-19 10:40:37 | 只看该作者
jfnano 发表于 2014-7-19 09:50
这种还不如直接重写,

说的容易,要不你帮我写下?上边那个我自己解决了,你如果会写的话,帮我重新写下这个?不用goto语句,不胜感激
[Fortran] 纯文本查看 复制代码
10    CONTINUE
      IF(KX.GT.KSX.AND.KY.GT.KSY) GOTO 70
      IF(KX.LE.KSX) THEN
        KXI=X(KX,2)
        KXJ=X(KX,3)
      ENDIF
      IF(KY.LE.KSY) THEN
        KYI=Y(KY,2)
        KYJ=Y(KY,3)
      ENDIF
      KSZ=KSZ+1
          IF(KSZ.EQ.M5) THEN
            WRITE(*,*) ' KSZ=M5=',M5,KSX,KSY,' Increase M5(in plus)!'
            STOP
          ENDIF
      IF(KX.GT.KSX) GOTO 40
      IF(KY.GT.KSY) GOTO 20
      IF(KXI.EQ.KYI.AND.KXJ.EQ.KYJ) GOTO 30
      IF(KYI.LT.KXI.OR.(KYI.EQ.KXI.AND.KYJ.LT.KXJ)) GOTO 40

20        Z(KSZ,1)=X(KX,1)
50        Z(KSZ,2)=X(KX,2)
        Z(KSZ,3)=X(KX,3)
        KX=KX+1
        GOTO 10

30        Z(KSZ,1)=X(KX,1)+Y(KY,1)
        KY=KY+1
        GOTO 50

40        Z(KSZ,1)=Y(KY,1)
        Z(KSZ,2)=Y(KY,2)
        Z(KSZ,3)=Y(KY,3)
        KY=KY+1
        GOTO 10
70    CONTINUE

6

帖子

1

主题

0

精华

入门

F 币
74 元
贡献
53 点
地板
发表于 2014-7-19 10:44:46 | 只看该作者
[Fortran] 纯文本查看 复制代码
      IF(KY.LE.KSY) THEN
        KYI=Y(KY,2)
        KYJ=Y(KY,3)
      ENDIF

这样发更好看

1958

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1341 元
贡献
565 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

5#
发表于 2014-7-19 11:16:52 | 只看该作者
我帮楼主改了,嘿嘿。

话说,修改老代码是个费劲的活儿,唉......

66

帖子

5

主题

2

精华

版主

院士级水师

F 币
481 元
贡献
273 点

管理勋章帅哥勋章爱心勋章规矩勋章

QQ
6#
发表于 2014-7-19 12:34:22 | 只看该作者
fcode 发表于 2014-7-19 11:16
我帮楼主改了,嘿嘿。

话说,修改老代码是个费劲的活儿,唉......

你就是太好了,我看着论坛里面这一板块都快被楼主刷屏了,什么问题都问,感觉楼主就是自己不动脑子的那一类,感觉问的问题都是写思路简单,改写繁琐的活,技术含量并不是很高。老大,应该狠心叫楼主自己锻炼下的。
科研穷三代,读博毁一生

46

帖子

12

主题

0

精华

熟手

F 币
116 元
贡献
104 点
7#
 楼主| 发表于 2014-7-19 13:56:10 | 只看该作者
岸边的鱼 发表于 2014-7-19 12:34
你就是太好了,我看着论坛里面这一板块都快被楼主刷屏了,什么问题都问,感觉楼主就是自己不动脑子的那一 ...

关键是我不会啊!不会还不能问,要啥技术含量啊?这改写繁琐的不需要技术啊?

46

帖子

12

主题

0

精华

熟手

F 币
116 元
贡献
104 点
8#
 楼主| 发表于 2014-7-19 14:36:08 | 只看该作者
fcode 发表于 2014-7-19 11:16
我帮楼主改了,嘿嘿。

话说,修改老代码是个费劲的活儿,唉......

这个不用goto只用IF和DO的话重新用FORTRAN编确实很繁琐,我只是想改成MATLAB,自己已经解决了
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-4-24 22:20

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表