Fortran Coder

查看: 1887|回复: 1
打印 上一主题 下一主题

[流程控制] 怎么把几个子程序里面的goto语句改成循环和判断语句呀

[复制链接]

1

帖子

1

主题

0

精华

新人

F 币
9 元
贡献
3 点
跳转到指定楼层
楼主
发表于 2023-2-23 16:57:24 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
IF(KREST.EQ.1) GO TO 1001
       READ(1,69) (IHEDIN(IH),IH=1,40)
       READ(1,*) KPI,KSI
   69  FORMAT(40A2)
   98  FORMAT(2I5)
   61  FORMAT(20A2)
   66  FORMAT(10F8.2)
       IF(KPI.NE.0) GO TO 5601
       READ(1,61)(IHEDIN(IH) ,IH=1,20)
           READ(1,*)PI
      READ(1,61) (IHEDIN(IH),IH=1,20)
           READ(1,*)PGOC
       READ(1,61)  (IHEDIN(IH),IH=1,20)
           READ(1,*)WOC
       READ(1,61) (IHEDIN(IH),IH=1,20)
           READ(1,*)GOC
       PI=SIP*PI
       DO 200 K=1,KK
       DO 200 J=1,JJ
       DO 200 I=1,II
       IF(EL(I,J,K).LT.GOC) GO TO 175
       IF(EL(I,J,K).GT.WOC)GO TO 150
       BPT=PBOT(I,J,K)
       CALL INTPVT(BPT,BSLOPE,POT,BOT,MPOT,PI,BBO)
       CALL INTPVT(BPT,RSLOPE,POT,RSOT,MPOT,PI,RSO)
       RHOO=(RHOSCO+RSO*RHOSCG)/BBO
       PN(I,J,K)=PI+RHOO*(EL(I,J,K)-WOC)*.09671
       GO TO 200
  150  CALL INTERP(PWT,BWT,MPWT,PI,BBW)
       CALL INTERP(PWT,RSWT,MPWT,PI,RSW)
       RHOW=(RHOSCW+RSW*RHOSCG)/BBW
       PN(I,J,K)=PI+RHOW*(EL(I,J,K)-WOC)*.09671
       GO TO 200
  175  CALL INTERP(PGT,BGT,MPGT,PGOC,BBG)
       RHOG=RHOSCG/BBG
       PN(I,J,K)=PGOC+RHOG*(EL(I,J,K)-GOC)*.09671
  200  CONTINUE
       GO TO 4010
5601  IF(KPI.EQ.1) THEN
       READ(1,61)(IHEDIN(IH) ,IH=1,20)
         DO 3010 K=1,KK
       READ(1,61)(IHEDIN(IH) ,IH=1,20)
       DO 3010 J=1,JJ
3010  READ(1,*)(PN(I,J,K),I=1,II)
        DO 3005 K=1,KK
        DO 3005 J=1,JJ
        DO 3005 I=1,II
        PN(I,J,K)=PN(I,J,K)*SIP
3005  CONTINUE
         ELSE IF(KPI.EQ.-1) THEN
       READ(1,61)(IHEDIN(IH) ,IH=1,20)
         READ(1,*)(PPX(K),K=1,KK)
         DO 3008 K=1,KK
         DO 3008 J=1,JJ
         DO 3008 I=1,II
         PN(I,J,K)=PPX(K)*SIP
3008         CONTINUE
         ENDIF
4010  CONTINUE
C****  INITIALIZE N+1,II
       DO 3012 I=1,II
       DO 3012 J=1,JJ
       DO 3012 K=1,KK
3012  P(I,J,K)=PN(I,J,K)
        IF(KSI.NE.0)GO TO 5600
      READ(1,69)(IHEDIN(IH),IH=1,40)
       READ(1,*)SOI,SWI,SGI
       DO 30 K=1,KK
       DO 30 J=1,JJ
       DO 30 I=1,II
       SON(I,J,K)=SOI
       SWN(I,J,K)=SWI
       SGI=1.0-SOI-SWI
       SGN(I,J,K)=SGI
       SO(I,J,K)=SOI
       SW(I,J,K)=SWI
       SG(I,J,K)=SGI
       IF(SG(I,J,K).LT.0.0) SG(I,J,K)=0.0
  30   CONTINUE
       READ(1,69)(IHEDIN(IH),IH=1,40)
       WRITE(6,1111)(IHEDIN(IH),IH=1,40)
1111  FORMAT(20X,38('*')/20X,40A2/20X,38('*')/)
3015   RETURN
5600  DO 3011 K=1,KK
       READ(1,69)(IHEDIN(IH),IH=1,40)
       DO 3006 J=1,JJ
3006   READ(1,*)(SO(I,J,K),I=1,II)
3011   CONTINUE

       DO 3020 K=1,KK
       READ(1,69)(IHEDIN(IH),IH=1,40)
       DO 3007 J=1,JJ
3007   READ(1,*)(SW(I,J,K),I=1,II)
3020   CONTINUE
       DO 3030 K=1,KK
       DO 3030 J=1,JJ
       DO 3030 I=1,II
       SG(I,J,K)=1.0-SO(I,J,K)-SW(I,J,K)
       IF(SG(I,J,K).LT.0.0) SG(I,J,K)=0.0
       SON(I,J,K)=SO(I,J,K)
       SWN(I,J,K)=SW(I,J,K)
       SGN(I,J,K)=SG(I,J,K)
3030  CONTINUE
       READ (1,69)(IHEDIN(IH),IH=1,40)
       WRITE(6,1111)(IHEDIN(IH),IH=1,40)
       GO TO 9009
1001  CONTINUE
C
C
C      ********* I-- READ OF INITIAL WELL PRODUCTION DATA *********
       DO 2202 K=1,KK
2202  READ(2,1114)KKK, OOIP(K),OWIP(K),ODGIP(K),OFGIP(K)
       READ (2,1115) TOOIP
1114  FORMAT(I5,4F10.4)
1115  FORMAT(4F10.4)
C
       READ(2,1113)NVQN1
       DO 1101 I=1,NVQN1
       DO 1101 K=1,KK
       READ(2,1116)III,KKK,CUMO(I,K),CUMW(I,K),CUMG(I,K)
1101  CONTINUE
1116  FORMAT(2I5,3F10.0)
1113  FORMAT(I5)
C
C      ********* 2-- READ OF CUMMULATIVE PRODUCTION DATA **********
C
       READ(2,4441)(IHEDIN(IH),IH=1,18),ETIR
       READ(2,4442)(IHEDIN(IH),IH=1,18),NRESTT
       READ(2,4441)(IHEDIN(IH),IH=1,18),PAVG0
       READ(2,4443)(IHEDIN(IH),IH=1,18),COP
       READ(2,4443)(IHEDIN(IH),IH=1,18),CGP
       READ(2,4443)(IHEDIN(IH),IH=1,18),CWP
       READ(2,4443)(IHEDIN(IH),IH=1,18),CGI
       READ(2,4443)(IHEDIN(IH),IH=1,18),CWI
4441  FORMAT(18A2,F10.0)
4442  FORMAT(18A2,I5)
4443  FORMAT(18A2,E10.4)
       WRITE(6,4444)ETIR,NRESTT,PAVG0,COP/1000.0,CGP/1000.0,
     &              CWP/1000.0,CGI/1000.0,CWI/1000.0
4444  FORMAT(35X,'ELAPSED TIME(DAYS)                 =',F10.2,' DAYS'
     &  ,/35X,'TIMESTEP NUMBER                    =',I5,/
     &    35X,'CURRENT AVERAGE RESERVOIR PRESSURE =',F10.2,'MPa',/
     &   35X,'CUM. OIL PRODUCTION                =',E10.4,'*1000M^3',
     &  /35X,'CUM. GAS PRODUCTION                =',E10.4,'*1000M^3',
     &  /35X,'CUM. WATER PRODUCTION              =',E10.4,'*1000M^3',
     &  /35X,'CUM GAS INJECTION                  =',E10.4,'*1000M^3',
     &  /35X,'CUM WATER INJECTION                =',E10.4,'*1000M^3')
C
C      ********* 3-- PRESSURE AND SATURATION DATA READING *********
C
       PAVG0=9.869*PAVG0
       DO 202 K=1,KK
       READ(2,444)(IHEDIN(IH),IH=1,4),KLAY
       DO 202 J=1,JJ
       READ(2,333)(P(I,J,K),I=1,II)
  202  CONTINUE
  333  FORMAT(10F8.4)
  444  FORMAT(4A2,I2)
C
       DO 303 K=1,KK
       READ(2,444)(IHEDIN(IH),IH=1,4),KLAY
       DO 303 J=1,JJ
       READ(2,333)(SO(I,J,K),I=1,II)
  303  CONTINUE
C
       DO 404 K=1,KK
       READ(2,444)(IHEDIN(IH),IH=1,4),KLAY
       DO 404 J=1,JJ
       READ(2,333)(SW(I,J,K),I=1,II)
  404  CONTINUE
C
       DO 505 K=1,KK
       READ(2,444)(IHEDIN(IH),IH=1,4),KLAY
       DO 505 J=1,JJ
       READ(2,333)(SG(I,J,K),I=1,II)
  505  CONTINUE
C
       DO 606 K=1,KK
       READ(2,444)(IHEDIN(IH),IH=1,4),KLAY
       DO 606 J=1,JJ
       READ(2,333)(PBOT(I,J,K),I=1,II)
  606  CONTINUE
C
       DO 908 K=1,KK
       DO 908 J=1,JJ
       DO 908 I=1,II
       P(I,J,K)=9.869*P(I,J,K)
       PN(I,J,K)=P(I,J,K)
       PBOT(I,J,K)=9.869*PBOT(I,J,K)
       SON(I,J,K)=SO(I,J,K)
       SWN(I,J,K)=SW(I,J,K)
       SGN(I,J,K)=SG(I,J,K)
908   CONTINUE
9009  CONTINUE
C
       RETURN
       END


分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

250

帖子

2

主题

0

精华

宗师

F 币
1730 元
贡献
872 点

规矩勋章

沙发
发表于 2023-2-25 17:59:28 | 只看该作者
上面DO循环里的GO TO 200相当于cycle,其他的需要做if判断
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

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

GMT+8, 2024-4-26 22:37

Powered by Tencent X3.4

© 2013-2024 Tencent

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