| 查看: 803 | 回复: 2 | ||
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-* |
回复此楼» 猜你喜欢
售SCI一区文章，我:8.O.551.O.5.4,科目全,可伽急
已经有5人回复
-
售SCI一区T0P文章，我:8.O.55.1.O.5.4,科目全,可+急
已经有5人回复
-
售SCI一区T0P文章，我:8.O.55.1.O.5.4,科目全,可+急
已经有4人回复
-
售SCI一区T0P文章，我:8O.55.1.O.5.4,科目齐全,可+急
已经有4人回复
-
2026年8月25日国自然放榜前突然收到列入评审专家邮件，有关系吗？
已经有20人回复
-
今天务委会开完了，明天出结果吗
已经有22人回复
-
在坚冰还盖着北海的时候，我看到了怒放的梅花。
已经有9人回复
-
明天应该可查了！？
已经有6人回复
-
有没有大神帮我看看基金代码
已经有10人回复
-
放榜前的不淡定
已经有19人回复
» 本主题相关价值贴推荐，对您同样有帮助:
- 菜鸟求助关于fortran if循环的问题，经验丰富的前辈肯定一眼能看出问题出在哪
已经有3人回复
- 有没有大神看一下能不能用FORTRAN求解下面的式子
已经有14人回复
- ansys结果数据导出为txt文件，文件大小有限制吗
已经有8人回复
- 求助！fortran编程实现从txt中一一对应读入数据
已经有6人回复
- 大家都用什么fortran编辑器，推荐一下，最好是能加亮或修改语句颜色的
已经有15人回复
dingxb
金虫 (正式写手)
迷途书虫
- 应助: 12 (小学生)
- 金币: 1674.5
- 帖子: 482
- 在线: 59.5小时
- 虫号: 34085
- 注册: 2004-01-06
- 性别: GG
- 专业: 原子和分子物理
2楼2015-01-28 09:41:23
baobiao007
木虫 (职业作家)
中国特色
- 应助: 201 (大学生)
- 金币: 6484.2
- 散金: 557
- 红花: 40
- 帖子: 3050
- 在线: 1009.9小时
- 虫号: 505962
- 注册: 2008-02-18
- 专业: 应用地球物理学
3楼2015-01-28 11:40:18
