应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » fortran语句DO循环，只能实现第一个，后面的无法生成的txt里面没有内容
31/1返回列表
查看: 802  |  回复: 2
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看

huanke05

木虫 (正式写手)

[求助] fortran语句DO循环，只能实现第一个，后面的无法生成的txt里面没有内容 已有1人参与

各位大虾，我是FORTRAN语言的小虾米，刚学着用Fortran来写代码，遇到了一个问题。就是代码可以生成成功，但是用DO循环，就只有第一个可以成功生成，后面生成的文件，都是控制，请各位大侠们指导。具体代码如下，金币不多，就先赠送200个吧，谢谢了！

      CHARACTER*20 FDATA
      CHARACTER*3 APMNU
                                                                        
      DIMENSION IAPL(50000),ICMO(50000),IE(50000),IFED(50000),IMW(50000),&
          IO(50000),IOP(50000),IOW(50000),IPTS(50000),IR(50000),IRR(50000),&
          ISAO(50000),ISOL(50000),IWTH(50000),KI(50000),IX(50000),IA(50000),&
          IY(50000),LM(50000),LUNS(50000),NBSA(50000),NVCN(50000),KR(3),KW(2)                                                                    
      DIMENSION AZM(50000),BCOF(50000),BFFL(50000),CHL(50000),CHS(50000),&
          DALG(50000),FFPQ(50000),PCOF(50000),RCHL(50000),RCHN(50000),RCHS&
          (50000),RSAE(50000),RSAP(50000),RSBD(50000),RSDP(50000),RSEE&
          (50000),RSEP(50000),RSHC(50000),RSRR(50000),RSV(50000),RSYN(50000),&
          RSYS(50000),RVE0(50000),RVP0(50000),SLG(50000),SLP(50000),UPN&
          (50000),URBF(50000),WSA(50000),XCT(50000),YCT(50000),XTP(4)                                                      
      DATA NN/50000/,KR/11,12,13/,KW/31,32/   

      SNO=0
        STDO=0
        FL=0
        FW=0
        ANGL=0
        CHD=0
        CHN=0
        RCHD=0
        RCBW=0
        RCTW=0
        RFPW=0
        IFD=0
        IDR=0
        EFI=0
        VIMX=0
        ARMN=0
        ARMX=0
        FNP4=0
        FMX=0
        DRT=0
        FDSF=0
        SFLG=0
        FIRG=0
ICMO=0

      OPEN(KR(3),FILE='APSUBRUN.DAT')     
DO
      READ(KR(3),28) FDATA
  
      IF(LEN_TRIM(FDATA)==0)STOP
          FDATA=ADJUSTR(FDATA)
      OPEN(KR(1),FILE=FDATA//'.DAT')                                                           
      OPEN(KR(2),FILE=FDATA//'.SAF')                                                            
      OPEN(KW(1),FILE=FDATA//'.OUT')                                                            
      OPEN(KW(2),FILE=FDATA//'.SUB')                                                            
                                                                                     

                                            
      READ(KR(1),33)IRI,IFA,IDF1,IDF2,IDF4,IDF5,IDF3                                       

      READ(KR(1),34)BIR,BFT,CHC,CHK,PEC,VLGN,COWW,DDLG,SOLQ,FNP2,FNP5                  
      DO I=1,N                                                                  
                  IX(I)=0                                                                        
                  IY(I)=0                                                                        
                  IA(I)=0                                                                        
          END DO
      READ(KR(2),3)II                                                                  
      DO I=1,NN                                                                    
                  READ(KR(2),*,IOSTAT=NFL)IE(I),IO(I),ISOL(I),IOP(I),IOW(I),&
                  IFED(I),IAPL(I),IDUM,NVCN(I),IWTH(I),IPTS(I),ISAO(I),&
                  LUNS(I),IMW(I),IRR(I),LM(I),WSA(I),CHL(I),CHS(I),UPN(I),&
                  SLG(I),SLP(I),RCHS(I),RCHL(I),RCHN(I),FFPQ(I),URBF(I),RSEE(I),&
                  RSAE(I),RVE0(I),RSEP(I),RSAP(I),RVP0(I),RSV(I),RSRR(I),RSYS&
                  (I),RSYN(I),RSHC(I),RSDP(I),RSBD(I),PCOF(I),BCOF(I),BFFL(I),&
                  DALG(I),YCT(I),XCT(I),AZM(I)
                  IF(NFL/=0)EXIT
                  WRITE(KW(1),3)IE(I),IO(I),ISOL(I),IOP(I),IOW(I),IFED(I),IAPL(I)&                 
                  ,IDUM,NVCN(I),IWTH(I),IPTS(I),ISAO(I),LUNS(I),IMW(I),IRR(I),&               
                  LM(I),WSA(I),CHL(I),CHS(I),UPN(I),SLG(I),SLP(I),RCHS(I),RCHL(I),&              
                  RCHN(I),FFPQ(I),URBF(I),RSEE(I),RSAE(I),RVE0(I),RSEP(I),RSAP(I),&              
                  RVP0(I),RSV(I),RSRR(I),RSYS(I),RSYN(I),RSHC(I),RSDP(I),RSBD(I),&               
                  PCOF(I),BCOF(I),DALG(I)                                                        

     END DO                                                         
      
NN=I-1                                                                        
      WRITE(KW(1),49)(IE(I),IO(I),I=1,NN)                                             
      IF(NN>1)CALL ASORT(IE,IO,NN)                                                
      WRITE(KW(1),'(///A)')'#####'                                                                       
      WRITE(KW(1),49)(IE(I),IO(I),I=1,NN)  
      
                                                
      DO I=1,NN                                                                  
                  NBSA(I)=IE(I)                                                                  
                  IE(I)=I                                                                        
                  IF(IO(I)==0)ICMO(I)=IE(I)                                                           
                  IF(IOW(I)<1)IOW(I)=1                                                        
                  KI(I)=I                                                                        
          END DO
      NN0=NN                                                                        
      IF(NN>=2)THEN
                  DO I=1,NN                                                                  
                          DO J=1,NN                                                                  
                                  IF(NBSA(I).NE.IO(J))CYCLE
                                  IR(J)=IE(I)                                                                    
                          END DO
                  END DO
                  !     IR(NN)=0                                                                       
                  DO I=1,NN                                                                  
                          II=IE(I)-I                                                                     
                          IY(IE(I))=II                                                                  
                          IE(I)=I                                                                        
                  END DO
                  DO I=1,NN                                                                  
                          IF(IR(I)<2)CYCLE
                          IR(I)=IR(I)-IY(IR(I))                                                         
                  END DO
                  DO I=1,NN                                                                  
                          IR(IE(I))=IR(I)                                                               
                  END DO
                  DO I=NN,1,-1                                                                           
                          IF(IR(KI(I))>0)CYCLE
                          IO(NN)=IE(KI(I))                                                               
                          CALL ELIM(KI,NN,I)  
                          EXIT                                                           
                  END DO                                                                       
                  I=NN0
                  DO WHILE(NN>0)                                                                          
                          DO J=1,NN                                                                  
                                  IF(IR(KI(J))==IO(I))EXIT
                          END DO
                          IF(J>NN)THEN                                                
                                  IX(IO(I))=1                                                                    
                                  K=IO(I)
                                  DO                                                                        
                                          DO J=1,NN                                                                  
                                                  IF(IR(KI(J))==IR(K))EXIT
                                          END DO
                                          IF(J<=NN)EXIT
                                          K=IR(K)
                                  END DO                                                                        
                                  I=I-1                                                                          
                                  IO(I)=IE(KI(J))
                          ELSE                                                               
                                  I=I-1                                                                          
                                  IO(I)=IE(KI(J))
                          END IF                                                               
                      CALL ELIM(KI,NN,J)
              END DO                                                            
                  IX(IO(1))=1                                                                    
                  DO I=1,NN0                                                                  
                          II=IR(IO(I))                                                                  
                          I1=I+1                                                                        
                          DO J=I1,NN0                                                                 
                                  IF(IR(IO(J))==II)IA(IO(J))=1                                                
                          END DO
                  END DO
          END IF
      DO I=1,NN0                                                                  
                  IF(NN0>1)THEN
                          I1=MAX0(1,IO(I))                                                               
                  ELSE
                          I1=I                                                                                
                          IX(I1)=1                                                                           
                  END IF
                  XX=SQRT(WSA(I1))                                                               
                  IF(IX(I1)>0)THEN
                          IF(CHL(I1)>0.)THEN
                                  RCHL(I1)=CHL(I1)                                                               
                          ELSE                                                      
                                  IF(RCHL(I1)>0.)THEN
                                          CHL(I1)=RCHL(I1)                                                            
                                  ELSE                                                     
                                          CHL(I1)=.1732*XX                                                               
                                          RCHL(I1)=CHL(I1)                                                               
                                  END IF
                          END IF
                  ELSE                                                        
                          IF(RCHL(I1)<1.E-10)THEN
                                  RCHL(I1)=.1*XX
                          ELSE                                                               
                                  IF(CHL(I1)<1.E-10)THEN
                                          CHL(I1)=.1732*XX
                                  ELSE                                                               
                                          IF(ABS(CHL(I1)-RCHL(I1))<1.E-5)CHL(I1)=1.732*RCHL(I1)                                                         
                                  END IF
                          END IF
                  END IF
                  IF(IA(I1)>0)THEN
                          X1=-WSA(I1)                                                                    
                  ELSE
                          X1=WSA(I1)                                                                     
                  END IF
                  XTP=0.                                                                        
                  X2=0.                                                                          
                  X5=0.
                  IF(IAPL(I1)>0)THEN
                          APMNU='SOA'                                                                    
                          IF(IDF2>0)X2=FNP2                                                           
                          IF(IDF5>0)X5=FNP5
                  ELSE
                          IF(IAPL(I1)==0)THEN                                                               
                                  APMNU='   '                                                                    
                          ELSE
                                  APMNU='LQA'                                                                                      
                          END IF
                  END IF
                  IF(IFED(I1)>0)THEN
                          XTP(1)=VLGN                                                                    
                          XTP(2)=COWW                                                                        
                          XTP(3)=DDLG                                                                        
                          XTP(4)=SOLQ                                                                        
                          APMNU='FDA'
                  END IF
                  Y1=0.
                  J1=0

        WRITE(KW(2),121)NBSA(I1),I,ICMO(I1),FDATA,APMNU
121      FORMAT(3I8,1X,A20,A3)   
        WRITE(KW(2),122)ISOL(I1),IOP(I1),IOW(I1),IFED(I1),IAPL(I1),IDUM,NVCN(I1),IWTH(I1),IPTS(I1),ISAO(I1),LUNS(I1),IMW(I1)
122     FORMAT(12I10)
        WRITE(KW(2),129) SNO, STDO, YCT(I1),XCT(I1), AZM(I1), FL, FW, ANGL
        WRITE(KW(2),123) WSA(I), RCHL(I), CHD, CHS(I), CHN, SLP(I), SLG(I), UPN(I), FFPQ(I), URBF(I)        
123     FORMAT(1I8,9F8.3)        
        WRITE(KW(2),129) RCHL(I), RCHD, RCBW, RCTW, RCHS(I), RCHN(I), CHC,CHK, RFPW, BFFL(I)

        WRITE(KW(2),131)RSEE(I),RSAE(I),RVE0(I),RSEP(I),RSAP(I),RVP0(I),RSV(I),RSRR(I), &
RSYS(I),RSYN(I)
        WRITE(KW(2),129) RSHC(I),RSDP(I),RSBD(I),PCOF(I),BCOF(I),BFFL(I)
        WRITE(KW(2),124) IRR(I),IRR(I1),IRI,IFA,LM(I1),IFD,IDR,IDF1,IDF2,IDF3,IDF4,IDF5
124     FORMAT(1I3,1I1,10I4)   

        WRITE(KW(2),131) BIR, EFI, VIMX, ARMN, ARMX, BFT, FNP4, FMX, DRT, FDSF
        WRITE(KW(2),131) PEC, DALG(I1), XTP, SFLG, FNP2, FNP5, FIRG
        WRITE(KW(2),130) J1,J1,J1,J1,J1,J1,J1,J1,J1,J1
        WRITE(KW(2),131) J1,J1,J1,J1,J1,J1,J1,J1,J1,J1
   
129     FORMAT(10F8.3)
130     FORMAT(20I8)
131     FORMAT(10F8.2)
        
      END DO
                                   
      WRITE(KW(2),'()')                                                              
      WRITE(KW(2),'()')
      CLOSE(KR(1))                                                                     
      CLOSE(KR(2))
      CLOSE(KW(1))
      CLOSE(KW(2))
      
      CYCLE
      END DO
      
      CLOSE(KR(3))
                                                                       
      STOP                                                                           
    3 FORMAT(I8,I9,4I5,I9,9I5,27F9.0)                                                
                                                                 
   28 FORMAT(A20)                                                                    
   33 FORMAT(7I4)                                                                    
   34 FORMAT(11F8.3)
   49 FORMAT(5X,2I10)                                                                                                                                 
      END                                                                           
!---+----1----+----2----+----3----+----4----+----5----+----6----+----7-*            
      SUBROUTINE ELIM(KI,NN,I)                                                      
      DIMENSION KI(50000)                                                            
      NN=NN-1                                                                        
      DO J=I,NN                                                                    
                  KI(J)=KI(J+1)
          END DO                                                                  
      RETURN                                                                        
      END                                                                           
!---+----1----+----2----+----3----+----4----+----5----+----6----+----7-*            
      SUBROUTINE ASORT(NZ,NY,M)                                                      
!     THIS SUBPROGRAM SORTS NUMBERS INTO ASCENDING ORDER USING                       
!     RIPPLE SORT                                                                    
      DIMENSION NY(M),NZ(M)                                                         
      NB=M-1                                                                        
      J=M                                                                           
      DO I=1,NB                                                                    
                  J=J-1                                                                          
                  MK=0                                                                           
                  DO K=1,J                                                                     
                          K1=K+1                                                                        
                          IF(NZ(K)<=NZ(K1))CYCLE
                          N1=NZ(K1)                                                                     
                          N2=NY(K1)                                                                     
                          NZ(K1)=NZ(K)                                                                  
                          NY(K1)=NY(K)                                                                  
                          NZ(K)=N1                                                                       
                          NY(K)=N2                                                                       
                          MK=1                                                                           
                  END DO
                  IF(MK==0)EXIT
          END DO                                                            
      RETURN                                                                        
      END                                                                           
!---+----1----+----2----+----3----+----4----+----5----+----6----+----7-*
回复此楼

» 猜你喜欢

» 本主题相关价值贴推荐，对您同样有帮助:
多发文章，想去国外学习
1楼 2015-01-27 13:46:04
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

dingxb

金虫 (正式写手)

迷途书虫

【答案】应助回帖

★ ★ ★ ★ ★
感谢参与，应助指数 +1
huanke05: 金币+5, ★★★很有帮助 2015-01-28 13:15:55
首先，这个程序是个不完整的程序，建议将完整的程序顺带相关输入数据，以及你的期待输出描述清楚。
其次，不是很确定到底哪个Do循环起了作用，建议说明。
我能找到的只有1个带有输出的Do循环，在72行，这里需要考虑nfl是不是不等于零。如果等于零则直接退出循环了。

希望对你有帮助！
赞一下(1人) 回复此楼
http://sites.google.com/site/nwnuatom/个人网站，欢迎猛击乱点！
2楼2015-01-28 09:41:23
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

baobiao007

木虫 (职业作家)

中国特色
申请这么多这么大的数组，你确定能申请成功？
赞一下(1人) 回复此楼
我同意叔本华的观点，人们投身艺术和科学领域的强烈愿望之一就是逃离痛苦、残酷和枯燥无味的现实生活，逃离自己飘忽不定的七情六欲的桎梏。--爱因斯坦
3楼2015-01-28 11:40:18
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 huanke05 的主题更新
31/1返回列表
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[基金申请] 2026年8月25日国自然放榜前突然收到列入评审专家邮件，有关系吗？ +17 木水思豆 2026-08-25 20/1000 2026-08-26 01:26 by chengyan1220
[基金申请] 今天务委会开完了，明天出结果吗 +18 angus9576 2026-08-25 22/1100 2026-08-26 00:41 by merchancy
[论文投稿] 售SCI一区T0P文章，我:8O.55.1.O.5.4,科目齐全,可+急 +3 7K1CJE38xLG4 2026-08-25 3/150 2026-08-26 00:40 by cNXvBfCpiZOM
[考研] 售SCI一区T0P文章，我:8.O.55.1.O.5.4,科目全,可+急 +3 7K1CJE38xLG4 2026-08-25 3/150 2026-08-25 23:20 by cNXvBfCpiZOM
[基金申请] 在坚冰还盖着北海的时候，我看到了怒放的梅花。 (金币+10) +6 ziyangfang 2026-08-25 9/450 2026-08-25 20:26 by huagongfeihu
[基金申请] 某些机构，以效率低为荣，以效率低作为存在感 +9 yuleib84 2026-08-25 10/500 2026-08-25 17:14 by alexon
[基金申请] 今日不放榜？网传国自然预计 8 月 27 日可查结果 +17 医学老男孩 2026-08-20 22/1100 2026-08-25 15:36 by 医学老男孩
[基金申请] 如果此刻你正在为国基感到焦虑，不妨来听听这首《基金之外》 +8 scalable 2026-08-24 8/400 2026-08-25 12:52 by jnhyjjm
[基金申请] 没有任何消息-是不是就凉了 +9 图啦图啦 2026-08-24 10/500 2026-08-25 11:59 by 南海小哥
[基金申请] 人气不行了 +11 fansofjerry 2026-08-21 11/550 2026-08-25 11:04 by 孤独的英雄6
[基金申请] 2026年的国家社科基金项目通讯评审的新规则与新动向、新挑战 +5 process2012 2026-08-23 7/350 2026-08-25 09:42 by huixian257
[基金申请] 今天基金会出结果吗？20260819 +17 kkkl_v 2026-08-19 18/900 2026-08-25 09:41 by windflowerwy
[基金申请] 只有每年这种时候来逛逛小木虫 +25 yaoyewhu2008 2026-08-20 27/1350 2026-08-25 08:01 by Equinoxhua
[基金申请] 能否退出参与的面上项目解除限项 +21 koalala 2026-08-24 24/1200 2026-08-24 19:25 by 家与远方
[基金申请] 科研孤儿太难了 +18 我4大白菜 2026-08-20 19/950 2026-08-24 09:47 by 凯恩广盛催化分�
[基金申请] 时间戳今天，20号变了 +5 archvillain 2026-08-20 5/250 2026-08-22 06:12 by hui_daxiao
[基金申请] 看来今天不会放榜了？ +8 chengyan1220 2026-08-21 11/550 2026-08-21 17:52 by dcqxinyang
[基金申请] 时间戳又变了 +13 wuchongjun 2026-08-20 19/950 2026-08-21 17:21 by 紫杉醇
[基金申请] 应该是下周三26日公布了吧？ +4 哈哈蛤？ 2026-08-21 4/200 2026-08-21 10:58 by Vivilian
[基金申请] 基金啊基金 +4 longfie172 2026-08-20 4/200 2026-08-21 08:58 by mark mao
信息提示
关闭
请填处理意见
关闭