论坛 › Fortran语法讨论 › 各位高人请看这个程序是怎么执行的

gengyan123456 发表于 2014-7-17 18:30:34

各位高人请看这个程序是怎么执行的

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
605FORMAT(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
606FORMAT(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.012.0
8   9   -1.000    0.000    1.000    0.010
9   7200.000    0.000    0.000    0.000
-1 0 0 0 0 0
531    10.50   0.00    1.000    0.00
3132    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.012.0
8   9   -1.000    0.000    1.000    0.010
9   7200.000    0.000    0.000    0.000
-1 0 0 0 0 0
531   4.00   0.00    1.000    0.00
3132    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.012.0
8   9   -1.000    0.000    1.000    0.010
9   7200.000    0.000    0.000    0.000
-1 0 0 0 0 0
-1 0 0 0 0 0
531   8.00   0.00    1.000    0.00
3132    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.012.0
8   9   -1.000    0.000    1.000    0.010
9   7200.000    0.000    0.000    0.000
-1 0 0 0 0 0
-1 0 0 0 0 0
531   8.00   0.00    1.000    0.00
3132    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

jfnano 发表于 2014-7-19 09:50:58

这种还不如直接重写，

gengyan123456 发表于 2014-7-19 10:40:37

jfnano 发表于 2014-7-19 09:50
这种还不如直接重写，
说的容易，要不你帮我写下？上边那个我自己解决了，你如果会写的话，帮我重新写下这个？不用goto语句，不胜感激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

jfnano 发表于 2014-7-19 10:44:46

      IF(KY.LE.KSY) THEN
      KYI=Y(KY,2)
      KYJ=Y(KY,3)
      ENDIF
这样发更好看

fcode 发表于 2014-7-19 11:16:52

我帮楼主改了，嘿嘿。

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

岸边的鱼 发表于 2014-7-19 12:34:22

fcode 发表于 2014-7-19 11:16
我帮楼主改了，嘿嘿。

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

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

gengyan123456 发表于 2014-7-19 13:56:10

岸边的鱼 发表于 2014-7-19 12:34
你就是太好了，我看着论坛里面这一板块都快被楼主刷屏了，什么问题都问，感觉楼主就是自己不动脑子的那一 ...

关键是我不会啊！不会还不能问，要啥技术含量啊？这改写繁琐的不需要技术啊？

gengyan123456 发表于 2014-7-19 14:36:08

fcode 发表于 2014-7-19 11:16
我帮楼主改了，嘿嘿。

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

这个不用goto只用IF和DO的话重新用FORTRAN编确实很繁琐，我只是想改成MATLAB，自己已经解决了

查看完整版本: 各位高人请看这个程序是怎么执行的