| 5 | 1/1 | 返回列表 |
| 查看: 2114 | 回復(fù): 4 | ||
xin.fan.cupb新蟲 (初入文壇)
|
[求助]
Fortran77 代碼調(diào)試中提示有Syntax error,但卻不知道為什么出錯。望高人指點!
|
|
最近本人剛開始學(xué)Fortran編程,為方便學(xué)習(xí)將教科書上的Fortran代碼輸入進Fortran Powerstation中,編譯時卻提示好多錯誤,不知是哪里出了問題?附上部分程序和錯誤提示,希望好心人有時間給看看。。。 我已將源代碼和其中的問題貼在了附件中,大家感興趣的可以下載查看下。 非常感謝大家的幫助! |
新蟲 (初入文壇)
新蟲 (初入文壇)
金蟲 (正式寫手)
|
PROGRAM LWA C PLANE FRAME STRUCTURAL ANALYSIS PROGRAM DIMENSION JE(400,2),JN(400,3),KA(300),JS(20,4),MHT(300), * EA(400),EI(400),X(400),Y(400),PJ(40,4),PF(400,4), * P(300),BK(5000),EG(400) OPEN(1,FILE='LYP1.DAT') OPEN(2,FILE='LYP2.DAT',STATUS='NEW',ACCESS='SEQUENTIAL') 10 READ(1,*)NE,NJ,NS,NP,NWE,NWP K0=NE+NJ IF (K0.EQ.0) STOP WRITE(2,20)NE,NJ,NS,NP,NWE,NWP 20 FORMAT(//10X,'NE=',I5,2X,'NJ=',I5,2X,'NS=',I5,2X,'NP=',I5, * /10X,'NWE=',I5,2X,'NWP=',I5) CALL INPUT(NE,NJ,NS,JE,JS,EA,EI,EG,X,Y) CALL CIR1(N,NJ,NS,JN,JS) N1=N+1 CALL DGKK(N1,N,NE,NN,NJ,JE,JN,KA,MHT) CALL STIF(N1,N,NE,NJ,NN,JE,JN,KA,EA,EI,EG,X,Y,BK,NWE) CALL SOLV(N1,-1,N,NN,NJ,JN,KA,P,BK) LC=1 50 READ(1,*)NPJ,NPF WRITE(2,30)LC,NPJ,NPF 30 FORMAT(//10X,'LOAD CASE=',I5,2X,'NPJ=',I5,2X,'NPF=',I5) NPJ1=NPJ NPF1=NPF IF (NPJ.EQ.0)NPJ=1 IF (NPF.EQ.0)NPF=1 CALL SLV(N,NE,NJ,NPJ,NPF,NPJ1,NPF1,JE,JN,EA,EI,EG,X,Y, * PJ,PF,P,NWP) CALL SOLV(N1,1,N,NN,NJ,JN,KA,P,BK) CALL MQN(N,NE,NJ,NPF,NPF1,JE,JN,EA,EI,EG,X,Y,PF,P,NWE) LC=LC+1 IF (LC.LE.NP) GOTO 50 GOTO 10 CLOSE(1) CLOSE(2) END SUBROUTINE INPUT(NE,NJ,NS,JE,JS,EA,EI,EG,X,Y) DIMENSION JE(NE,2),JS(NS,4),EA(NE),EI(NE),X(NJ),Y(NJ),EG(400) READ(1,*)(X(I),Y(I),I=1,NJ) READ(1,*)(JE(I,1),JE(I,2),EA(I),EI(I),EG(I),I=1,NE) READ(1,*)((JS(I,J),J=1,4),I=1,NS) WRITE(2,20) WRITE(2,40)(I,X(I),Y(I),I=1,NJ) WRITE(2,30) WRITE(2,50)(I,JE(I,1),JE(I,2),EA(I),EI(I),EG(I),I=1,NE) WRITE(2,55) WRITE(2,60)((JS(I,J),J=1,4),I=1,NS) 20 FORMAT(//1X,'NODAL POINT COORDINATES'//7X, * 'NOODE'/5X,'NUMBER',6X,'X',9X,'Y') 40 FORMAT(1X,I10,2F10.4) 30 FORMAT(/1X,'ELEMENT DATA'//4X,'ELEMENT'/5X,'NUMBER',4X, * 'NODE-I',4X,'NODE-J',8X,'EA',10X,'EI',10X,'EG') 50 FORMAT(1X,3I6,3E15.6) 55 FORMAT(//1X,'SPECIAL NODAL POINT DATA'//7X,'NODE'/5X, * /'NUMBER',8X,'XX',8X,'YY',8X,'ZZ') 60 FORMAT(1X,4I10) RETURN END SUBROUTINE CIR1(N,NJ,NS,JN,JS) DIMENSION JN(NJ,3),JS(NS,4) DO 10 J=1,NJ DO 10 I=1,3 10 JN(J,I)=0 DO 20 J=1,NS L=JS(J,1) DO 20 I=1,3 20 JN(L,I)=JS(J,I+1) N=0 ID=0 DO 30 J=1,NJ DO 30 I=1,3 IF (JN(J,I)-1) 40,50,60 40 N=N+1 JN(J,I)=N GOTO 30 50 JN(J,I)=0 GOTO 30 60 ID=1 30 CONTINUE IF (ID.EQ.0) GOTO 100 DO 80 J=1,NS L=JS(J,1) DO 80 I=1,3 K=JS(J,I+1) IF (K.LE.1) GOTO 80 JN(L,I)=JN(K,I) 80 CONTINUE 100 RETURN END SUBROUTINE DGKK(N1,N,NE,NN,NJ,JE,JN,KA,MHT) DIMENSION JE(NE,2),JN(NJ,3),KA(N1),JC(6),MHT(N1) DO 10 I=1,N1 MHT(I)=0 10 KA(I)=0 DO 20 M=1,NE CALL EJC(M,NE,NJ,JE,JN,JC) MIN=10000 DO 30 I=1,6 J=JC(I) IF (J.EQ.0) GOTO 30 IF (MIN.GT.J) MIN=J 30 CONTINUE DO 20 I=1,6 J=JC(I) IF (J) 20,20,15 15 NW=J-MIN IF (NW.GT.MHT(J)) MHT(J)=NW 20 CONTINUE KA(1)=1 KA(2)=2 IF (N.EQ.1) GOTO 100 DO 40 I=2,N 40 KA(I+1)=KA(I)+MHT(I)+1 100 CONTINUE NN=KA(N+1)-1 RETURN END SUBROUTINE EJC(M,NE,NJ,JE,JN,JC) C CONNECTION MATRIX BETWEEN GLOBAL AND LOCAL FREEDOM DIMENSION JE(NE,2),JN(NJ,3),JC(6) J1=JE(M,1) J2=JE(M,2) DO 10 I=1,3 JC(I)=JN(J1,I) 10 JC(I+3)=JN(J2,I) RETURN END SUBROUTINE CSL(M,NE,NJ,BL,CO,SI,JE,X,Y) C CALCULATION OF COSIN AND SIN DIMENSION JE(NE,2),X(NJ),Y(NJ) J1=JE(M,1) J2=JE(M,2) DX=X(J2)-X(J1) DY=Y(J2)-Y(J1) BL=SQRT(DX*DX+DY*DY) SI=DY/BL CO=DX/BL RETURN END SUBROUTINE STIF1(BL,CO,SI,CA,CI,CG,EK,IO,NWE) DIMENSION EK(6,6) A=CA/BL G=2.0*CI/BL G2=3.0*G/BL G3=2.0*G2/BL IF (CG.EQ.0) GOTO 1 1 G4=G3*BL/CG GOTO 2 2 G4=0.0 G=G/(1.+G4) G2=G2/(1.+G4) G3=G3/(1.+G4) S=A*CO*CO+G3*SI*SI EK(1,1)=S EK(1,4)=-S EK(4,4)=S S=A*SI*SI+G3*CO*CO EK(2,2)=S EK(2,5)=-S EK(5,5)=S S=CO*SI*(A-G3) EK(1,2)=S EK(1,5)=-S EK(2,4)=-S EK(4,5)=S S=-G2*SI EK(1,3)=S EK(1,6)=S EK(3,4)=-S EK(4,6)=-S S=G2*CO EK(2,3)=S EK(2,6)=S EK(3,5)=-S EK(5,6)=-S S=G*(4.+G4)/2.0 EK(3,3)=S EK(6,6)=S EK(3,6)=G*(2.0-G4)/2.0 DO 10 I=1,5 I1=I+1 DO 10 J=I1,6 10 EK(J,I)=EK(I,J) IF (NWE.EQ.0) GOTO 60 WRITE(2,50) IO WRITE(2,30) EK NWE=0 30 FORMAT(1X/1X,6E13.5) 50 FORMAT(1X/5X,'NE=',I5) 60 RETURN END SUBROUTINE STIF(N1,N,NE,NJ,NN,JE,JN,KA,EA,EI,EG,X,Y,BK,NWE) DIMENSION JE(NE,2),JN(NJ,3),KA(N1),JC(6),EA(NE), * EG(NE),EI(NE),X(NJ),Y(NJ),BK(NN),EK(6,6) DO 10 I=1,NN 10 BK(I)=0.0 DO 20 M=1,NE CA=EA(M) CI=EI(M) CG=EG(M) CALL CSL(M,NE,NJ,BL,CO,SI,JE,X,Y) CALL STIF1(BL,CO,SI,CA,CI,CG,EK,M,NWE) CALL EJC(M,NE,NJ,JE,JN,JC) DO 30 K=1,6 J=JC(K) IF (J) 30,30,15 15 JJ=KA(J) DO 40 L=1,6 I=JC(L) IF (I) 40,40,16 16 ML=J-I IF (ML) 40,17,17 17 JI=JJ+ML BK(JI)=BK(JI)+EK(L,K) 40 CONTINUE 30 CONTINUE 20 CONTINUE RETURN END SUBROUTINE SOLV(N1,ID,N,NN,NJ,JN,KA,P,BK) DIMENSION KA(N1),JN(NJ,3),P(N),BK(NN),DI(3) IF (N.EQ.1) GOTO 150 IF (ID) 5,5,150 5 DO 140 J=2,N MJ=KA(J) KL=MJ+1 KU=KA(J+1)-1 KH=KU-KL IF (KH) 110,90,50 50 I=J-KH NUMJ=0 KLT=KU DO 80 I=1,KH NUMJ=NUMJ+1 KLT=KLT-1 MI=KA(I) NUMI=KA(I+1)-MI-1 IF (NUMI) 80,80,60 60 KK=MIN0(NUMI,NUMJ) C=0 DO 70 L=1,KK 70 C=C+BK(MI+L)*BK(KLT+L) BK(KLT)=BK(KLT)-C 80 I=I+1 90 I=J B=0 DO 100 KK=KL,KU I=I-1 MI=KA(I) C=BK(KK)/BK(MI) B=B+C*BK(KK) 100 BK(KK)=C BK(MJ)=BK(MJ)-B 110 IF (BK(MJ).NE.0) GOTO 140 GOTO 990 140 CONTINUE GOTO 990 150 DO 180 J=1,N KL=KA(J)+1 KU=KA(J+1)-1 IF (KU-KL) 180,160,160 160 I=J C=0 DO 170 KK=KL,KU I=I-1 170 C=C+BK(KK)*P(I) P(J)=P(J)-C 180 CONTINUE DO 200 I=1,N MI=KA(I) 200 P(I)=P(I)/BK(MI) IF (N.EQ.1) RETURN I=N DO 230 L=2,N KL=KA(I)+1 KU=KA(I+1)-1 IF (KU-KL) 230,210,210 210 J=I DO 220 KK=KL,KU J=J-1 220 P(J)=P(J)-BK(KK)*P(I) 230 I=I-1 WRITE(2,1010) 1010 FORMAT(//1X,'DISPLACEMENTS',1X,'OR ROTATIONS OF NODES', * //7X,'NODE',11X,'X-',13X,'Y-',13X,'Z-',/5X,'NUMBER', * 5X,'TRANSLATION',5X,'TRANSLATION',7X,'ROTATION') DO 1100 J=1,NJ DO 1200 I=1,3 DI(I)=0.0 L=JN(J,I) IF (L.EQ.0) GOTO 1200 DI(I)=P(L) 1200 CONTINUE WRITE(2,1300) J,DI(1),DI(2),DI(3) 1300 FORMAT(1X,I10,3E15.6) 1100 CONTINUE 990 RETURN END SUBROUTINE BOQ(I,NPF,BL,EA,EI,EG,PF,F0) DIMENSION PF(NPF,4),F0(6) IND=PF(I,2) A=PF(I,3) Q=PF(I,4) C=A/BL G=C*C B=BL-A DO 5 J=1,6 5 F0(J)=0.0 GOTO (10,20,30,40,50,60,70,80,90,100) IND 10 S=Q*A*0.5 F0(2)=-S*(2.0-2.0*G+C*G) F0(5)=-S*G*(2.0-C) S=S*A/6.0 F0(3)=S*(6.0-8.0*C+3.0*G) F0(6)=-S*C*(4.0-3.0*C) GOTO 200 20 S=B/BL F0(2)=-Q*S*S*(1.0+2.0*C) F0(5)=-Q*G*(1.0+2.0*S) F0(3)=Q*S*S*A F0(6)=-Q*B*G GOTO 200 30 S=B/BL F0(2)=-6.0*Q*C*S/BL F0(5)=-F0(2) F0(3)=Q*S*(2.0-3.0*S) F0(6)=Q*C*(2.0-3.0*C) GOTO 200 40 F0(1)=-Q*B/BL F0(4)=-Q*C GOTO 200 50 S=Q*A*0.25 F0(2)=-S*(2.0-3.0*G+1.60*C*G) F0(5)=-S*G*(3.0-1.60*C) S=S*A F0(3)=S*(2.0-3.0*C+1.20*G)/1.5 F0(6)=-S*C*(1.0-0.80*C) GOTO 200 60 F0(1)=-Q*A*(1.0-0.50*C) F0(4)=-0.50*Q*C*A GOTO 200 70 F0(2)=-Q F0(5)=Q GOTO 200 80 L=INT(A) S=Q*EA/BL F0(L)=S IF (L.EQ.1) F0(4)=-S IF (L.EQ.4) F0(1)=-S GOTO 200 90 L=INT(A) F0(L)=12.0*EI*Q/(BL*BL*BL) IF (L.EQ.2) F0(5)=-F0(2) IF (L.EQ.5) F0(2)=-F0(5) F0(3)=0.50*BL*F0(5) F0(6)=F0(3) GOTO 200 100 L=INT(A) S=2.0*EI*Q/BL F0(L)=2.0*S IF (L.EQ.3) F0(6)=S IF (L.EQ.6) F0(3)=S F0(5)=3.0*S/BL F0(2)=-F0(5) 200 RETURN END SUBROUTINE SLV(N,NE,NJ,NPJ,NPF,NPJ1,NPF1,JE,JN,EA,EI,EG,X, * Y,PJ,PF,P,NWP) DIMENSION JE(NE,2),JN(NJ,3),JC(6),EA(NE),EI(NE),X(NJ), * Y(NJ),PJ(NPJ,4),PF(NPF,4),F0(6),FE(6),P(N),EG(NE) DO 10 I=1,N 10 P(I)=0.0 IF (NPJ1.EQ.0) GOTO 50 READ(1,*)((PJ(I,J),J=1,4),I=1,NPJ) WRITE(2,20) WRITE(2,30)((PJ(I,J),J=1,4),I=1,NPJ) 20 FORMAT(//1X,'NODAL LOAD DATA'//8X,'LOCATION',11X,'LOAD', * /9X,'OF LOAD',10X,'VALUE') 30 FORMAT(1X,I4,3F15.4) DO 40 I=1,NPJ J=PJ(I,1) DO 39 K=1,3 L=JN(J,K) IF (L.EQ.0) GOTO 39 P(L)=PJ(I,K+1) 39 CONTINUE 40 CONTINUE 50 IF (NPF1.EQ.0) GOTO 100 READ(1,*)((PF(I,J),J=1,4),I=1,NPF) WRITE(2,60) WRITE(2,70)((PF(I,J),J=1,4),I=1,NPF) 60 FORMAT(//1X,'ELEMENT LOAD DATA'//4X,'ELEMENT',6X,'LOAD', * /7X,'DISTA NCE',9X,'LOAD'/5X,'NUMBER',5X,'CLASS',4X, * 'FROM NODE-I',8X,'VALUE') 70 FORMAT(1X,2F10.0,2F15.4) DO 81 I=1,NPF M=PF(I,1) CA=EA(M) CI=EI(M) CG=EG(M) CALL CSL(M,NE,NJ,BL,CO,SI,JE,X,Y) CALL BOQ(I,NPF,BL,CA,CI,CG,PF,F0) FE(1)=-F0(1)*CO+F0(2)*SI FE(2)=-F0(1)*SI-F0(2)*CO FE(3)=-F0(3) FE(4)=-F0(4)*CO+F0(5)*SI FE(5)=-F0(4)*SI-F0(5)*CO FE(6)=-F0(6) CALL EJC(M,NE,NJ,JE,JN,JC) DO 80 J=1,6 L=JC(J) IF (L.EQ.0) GOTO 80 P(L)=P(L)+FE(J) 80 CONTINUE IF (NWP.EQ.0) GOTO 81 WRITE(2,72)I WRITE(2,75)FE 72 FORMAT(1X/5X,'I-',I5) 75 FORMAT(1X/5X,3E17.5) 81 CONTINUE 100 RETURN END SUBROUTINE MQN(N,NE,NJ,NPF,NPF1,JE,JN,EA,EI,EG,X,Y,PF,P,NWE) DIMENSION JE(NE,2),JN(NJ,3),JC(6),EA(NE),EI(NE),X(NJ), * EG(NE),Y(NJ),PF(NPF,4),F(6),F0(6),FE(6),D(6),EK(6,6),P(N) WRITE (2,10) 10 FORMAT(//1X,'ELEMENT THRUSE/SHEAR/MOMENT'//4X,'ELEMENT' * /5X,'NUMBER',6X,'THRUST',12X,'SHEAR',13X,'MOMENT') DO 20 M=1,NE CA=EA(M) CI=EI(M) CG=EG(M) CALL CSL(M,NE,NJ,BL,CO,SI,JE,X,Y) CALL STIF1(BL,CO,SI,CA,CI,CG,EK,M,NWE) CALL EJC(M,NE,NJ,JE,JN,JC) DO 30 I=1,6 L=JC(I) D(I)=0.0 IF (L.EQ.0) GOTO 30 D(I)=P(L) 30 CONTINUE DO 40 I=1,6 S=0.0 DO 50 J=1,6 50 S=S+EK(I,J)*D(J) 40 FE(I)=S F(1)=FE(1)*CO+FE(2)*SI F(2)=-FE(1)*SI+FE(2)*CO F(3)=FE(3) F(4)=FE(4)*CO+FE(5)*SI F(5)=-FE(4)*SI+FE(5)*CO F(6)=FE(6) IF (NPF1.EQ.0) GOTO 80 DO 60 I=1,NPF L=PF(I,1) IF (M.NE.L) GOTO 60 CALL BOQ(I,NPF,BL,CA,CI,CG,PF,F0) Do 70 J=1,6 70 F(J)=F(J)+F0(J) 60 CONTINUE 80 WRITE(2,90) M,(F(I),I=1,6) 90 FORMAT(//1X,I10,3X,'N1=',F12.4,3X,'Q1=',F12.4,3X,'M1=', * F12.4,/14X,'N2=',F12.4,3X,'Q2=',F12.4,3X,'M2=',F12.4) 20 CONTINUE RETURN END |
新蟲 (初入文壇)
| 5 | 1/1 | 返回列表 |
| 最具人氣熱帖推薦 [查看全部] | 作者 | 回/看 | 最后發(fā)表 | |
|---|---|---|---|---|
|
[考研] 346求調(diào)劑[0856] +4 | WayneLim327 2026-03-16 | 7/350 |
|
|---|---|---|---|---|
|
[考研] 初始318分求調(diào)劑(有工作經(jīng)驗) +3 | 1911236844 2026-03-17 | 3/150 |
|
|
[考研] 278求調(diào)劑 +6 | 煙火先于春 2026-03-17 | 6/300 |
|
|
[考研] 材料 336 求調(diào)劑 +3 | An@. 2026-03-18 | 4/200 |
|
|
[考研] 294求調(diào)劑材料與化工專碩 +15 | 陌の森林 2026-03-18 | 15/750 |
|
|
[考研] 085600材料與化工 +8 | 安全上岸! 2026-03-16 | 8/400 |
|
|
[考研] 一志愿中南化學(xué)(0703)總分337求調(diào)劑 +8 | niko- 2026-03-19 | 9/450 |
|
|
[考研] 材料學(xué)求調(diào)劑 +4 | Stella_Yao 2026-03-20 | 4/200 |
|
|
[考研] 08工學(xué)調(diào)劑 +5 | 用戶573181 2026-03-20 | 5/250 |
|
|
[考研] 085601材料工程專碩求調(diào)劑 +10 | 慕寒mio 2026-03-16 | 10/500 |
|
|
[考研] 化學(xué)工程321分求調(diào)劑 +15 | 大米飯! 2026-03-15 | 18/900 |
|
|
[考研] 考研求調(diào)劑 +3 | 橘頌. 2026-03-17 | 4/200 |
|
|
[考研] 326求調(diào)劑 +5 | 上岸的小葡 2026-03-15 | 6/300 |
|
|
[考研] 302求調(diào)劑 +4 | 小賈同學(xué)123 2026-03-15 | 8/400 |
|
|
[考研] 考研調(diào)劑 +3 | 淇ya_~ 2026-03-17 | 5/250 |
|
|
[考研] 東南大學(xué)364求調(diào)劑 +5 | JasonYuiui 2026-03-15 | 5/250 |
|
|
[考研] 機械專碩325,尋找調(diào)劑院校 +3 | y9999 2026-03-15 | 5/250 |
|
|
[考研] 304求調(diào)劑 +4 | ahbd 2026-03-14 | 4/200 |
|
|
[考研] 0703化學(xué)調(diào)劑 290分有科研經(jīng)歷,論文在投 +7 | 膩膩gk 2026-03-14 | 7/350 |
|
|
[考研] 26考研一志愿中國石油大學(xué)(華東)305分求調(diào)劑 +3 | 嘉年新程 2026-03-15 | 3/150 |
|