مشکل در زبان برنامه نویسی فرترن
سلام دوستان عزیز 3 تا برنامه هست که به چند تا ارور جزئی ختم میشند اما نمیتونم درستشون کنم
لطفا بهم کمک کنید وقتتون رو زیاد نمیگیره
ممنونم
پروژه اول
کد:
PROGRAM
!TOW DIMENSIONAL TRUSS FINITE ELEMENT PROGRAM
!BY DR.J.RAAMACHANDRAN
DIMENSION CO(10,2),NO(10,2),ES(4,4)
DIMENSION S(20,20),Q(20)
PRINT *,'GIVE NUMBER OF NODES'
READ *,NP
PRINT *,'GIVE NUMBER OF ELEMENTS'
READ *,NE
PRINT *,'GIVE NUMBER OF BOUNDRY CONDITIONS'
READ *,NB
PRINT *,'GIVE NUMBER OF LOADED NODES'
READ *,NL
PRINT *,'GIVE YOUNGS MODULUS'
READ *,E
!THIS PROGRAM ASSUMES THAT ALL MEMBERS HAVE SAME AREA OF CROSS SECTION
PRINT *,'GIVE AREA OF CROSS SECTION'
READ *,A
NN=2*NP
DO 1 I=1,NN
Q(I)=0.0
DO 1 J=1,NN
S(I,J)=0.0
DO 2 I=1,NP
PRINT *,'GIVE X AND Y NODAL COORDINATES'
READ *,CO(I,1),CO(I,2)
CONTINUE
PRINT *,'GIVE END NODES OF EACH ELEMENT:NODAL CONNECTIVITY'
DO 3 I=1,NE
READ *,NO(I,1),NO(I,2)
CONTINUE
DO 4 N=1,NE
NI=NO(N,1)
NJ=NO(N,2)
DX=CO(NJ,1)-CO(NI,1)
DY=CO(NJ,2)-CO(NI,2)
EL=SQRT(DX*DX+DY*DY)
CA=DX/EL
SA=DY/EL
F=E*A/EL
ES(1,1)=F*CA*CA
ES(1,2)=F*SA*CA
ES(2,1)=F*SA*CA
ES(2,2)=F*SA*CA
DO 5 I=1,2
DO 5 J=1,2
ES(I,J+2)=-ES(I,J)
ES(I+2,J)=-ES(I,J)
CONTINUE
DO 6 I=1,2
DO 6 J=1,2
DO 6 IL=1,2
IE=2*(I-1)+IL
NR=2*NO(N,I)-2+IL
DO 6 JL=1,2
JE=2*(J-1)+JL
NC=2*NO(N,J)-2+JL
S(NR,NC)=S(NR,NC)+ES(IE,JE)
CONTINUE
CONTINUE
!GIVE LOADS
PRINT *,'GIVE NODE,X-LOAD,Y-LOAD'
DO 7 I=1,NL
READ *,N,Q(2*N-1),Q(2*N)
CONTINUE
PRINT *,"GIVE BOUNDARY CONDITIONS. 1 IF U=0 AND 2 IF V=0"
DO 8 I=1,NB
READ *,N,NF
NF=2*N-2+NF
DO 9 J=1,NN
S(NF,J)=0.0
S(J,NF)=0.0
S(NF,NF)=1.0
Q(NF)=0.0
CONTINUE
DO 10 I=1,NN
X=S(I,I)
Q(I)=Q(I)/X
DO 11 J=I+1,NN
S(I,J)=S(I,J)/X
CONTINUE
DO 12 K=1,NN
IF (K.EQ.I)GO TO 12
X=S(K,I)
Q(K)=Q(K)-X*Q(I)
DO 13 J=1,NN
S(K,J)=S(K,J)-X*S(I,J)
CONTINUE
CONTINUE
CONTINUE
PRINT *,'NODAL DISPLACEMENTS'
DO 14 I=1,NP
PRINT 15,I,Q(2*I-1),Q(2*I)
FORMAT(2X,'NODE=',14,5X,'V=',F7.4)
CONTINUE
PRINT *,'ELEMENT TENSIONS'
DO 16 N=1,NE
NI=NO(N,1)
NJ=NO(N,2)
DX=CO(NJ,1)-CO(NI,1)
DY=CO(NJ,2)-CO(NI,2)
EL=SQRT(DX*DX+DY*DY)
CA=DX/EL
SA=DY/EL
F=E*A/EL
U2=CA*Q (2*NJ-1)+SA*Q(2*NJ)
U1=CA*Q (2*NI-1)+SA*Q(2*NI)
T=F*(U2-U1)
PRINT17,N,T
FORMAT (2X,'NE=',12,5X,'T=',F8.4)
CONTINUE
STOP
END PROGRAM
پروژه دوم :
کد:
program prog
!PLANE STRESS AND STRAIN ANALYSES USING ISOPARAMETRC RECTANGULAR ELEMENT. PROGRAM BY DR.J.RAAMACHANDRAN.
DIMENSION S(100,20),Q(100),CO(50,2)
DIMENSION EM(8,8),XY(4,2),T(3,8),ED(8)
DIMENSION TJ(2,2),DL(2,4),C(3,8),ES(3)
WRITE(*,*) "GIVE NO. OF NODES"
READ(*,*) NP
WRITE(*,*) "GIVE NO. OF ELEMENTS"
READ(*,*)NE
WRITE(*,*) "GIVE NO. SETS OF PROPERTIES"
READ(*,*) NS
WRITE(*,*) "GIVE NO. OF BOUNDARY NODES"
READ(*,*) NB
WRITE(*,*) "GIVE NO. OF LOADED NODES"
READ(*,*) NL
NT=2*NP
WRITE(*,*) "GIVE YOUNGS MODULUS"
READ(*,*) E
WRITE(*,*) "GIVE POISSON RATIO"
READ(*,*) PR
WRITE(*,*) "GIVE THICKNESS"
READ(*,*) TH
WRITE(*,*)"GIVE NODAL COORDINATES: NODE, X,Y"
DO 1 I=1,NP
READ(*,*) I, CO(I,1),CO(I,2)
CONTINUE
NW=0
WRITE(*,*)"GIVE ELEMENT NODE NO. IN A/C WISE DIRECTION"
DO 4 I=1,NE
READ(*,*) NN(I,1),NN(I,2),NN(I,3),NN(I,4)
WRITE(*,*) I,NN(I,1),NN(I,2),NN(I,3),NN(I,4)
DO 3 J1=1,4
DO 2 J2=J1,4
NW1=ABS(NN(I,J1)-NN(I,J2))
IF(NW1.GT.NW) NW=NW1
CONTINUE
CONTINUE
CONTINUE
NW=NW*2+2
DO(1,1)=E*TH/(1-PR*PR)
D(2,2)=D(1,1)
D(1,2)=PR*D(1,1)
D(2,1)=D(1,2)
D(3,2)=0.5*(1-PR)*D(1,1)
D(3,2)=0.0
D(1,3)=0.0
D(2,3)=0.0
D(3,1)=D(1,3)
DO 6 I=1,NT
Q(I)=0.0
DO 5 J=1,20
S(I,J)=0.0
CONTINUE
CONTINUE
DO 17 N=1,NE
DO 8 I=1,8
DO 7 J=1,8
EM(I,J)=0.0
CONTINUE
CONTINUE
S3=SQRT(1/3)
DO 12 II=1,4
A=S3
B=A
IF(II.EQ.1) A=-A,B=-B
IF(II.EQ.2) B=-B
IF(II.EQ.4) A=-A
CALL CALC
DJ=ABS(DJ)
DO 11 I=1,8
DO 10 J=1,8
DO 9 K=1,3
EM(I,J)=EM(I,J)+C(K,I)*t(K,J)*DJ
CONTINUE
CONTINUE
CONTINUE
CONTINUE
DO 16 I=1,4
IN=NN(N,I)
DO 15 J=1,4
JN=NN(N,J)
DO 14 IL=1,2
IE=(I-1)*2+IL
NR=(IN-1)*2+IL
DO 13 JL=1,2
JE=(J-1)*2+JL
NC=(JN-1)*2+JL
NCB=NC-NR+1
S(NR,NCB)=S(NR,NCB)+EM(IE,JE)
CONTINUE
CONTINUE
CONTINUE
CONTINUE
WRITE(*,*) "ELEMENT",N
CONTINUE
WRITE(*,*) "NODAL LOADS"
WRITE(*,*)"NODE QX QY"
DO 18 I=1,NL
READ(*,*) N,Q(2*N-1),Q(2*N)
WRITE(*,*) N,Q(2*N-1),Q(2*N)
CONTINUE
WRITE(*,*)"GIVE BOUNDARY CONDITIONS"
WRITE(*,*)"NODE U V"
DO 19 I=1,NB
READ(*,*)N,NU,NV
WRITE(*,*)N,NU,NV
K=2*N-1
IF(NU.EQ.1) S(K,1)=S(K,1)*PF
IF(NV.EQ.1) S(K+1,1)=S(K+1,1)*PF
CONTINUE
DO 25 L=1,NP
ND=(NP-L+1)*2
IF(ND.GT.(NW-2)) LM=NW
DO 24 I=1,2
LM=LM-1
IP=2*(L-1)+I
X=S(IP,1)
Q(IP)=Q(IP)/X
DO 20 J=1,LM
RM(J)=S(IP,J+1)
CONTINUE
DO 21 JJ=1,LM+1
S(IP,JJ)=S(IP,JJ)/X
CONTINUE
DO 23 K=1,LM
NR=IP+K
NC=LM-K+1
X=RM(K)
Q(NR)=Q(NR)-X*Q(IP)
DO 22 J=1,NC
JP=J+K
S(NR,J)=S(NR,J)-X*S(IP,JP)
CONTINUE
CONTINUE
CONTINUE
CONTINUE
I=NT
Q(NT)=Q(NT)/S(NT,1)
I=I-1
IF(LM.LT.(NW-1)) LM=LM+1
DO 27 J=1,LM
Q(I)=Q(I)-S(I,J+1)*Q(I+J)
CONTINUE
IF(I.GT.1) GOTO 26
WRITE(*,*)"NODAL DISPLACEMENTS"
WRITE(*,*)"ELEMENT U V"
DO 29 I=1,NP
WRITE(*,28) I,Q(2*I-1),Q(2*I)
FORMAT(3X,I4,10X,F10.4,10X,F10.4)
CONTINUE
WRITE(*,*)"ELEMENT STRESSES"
WRITE(*,*)"ELE. NO. SIGMA-X SIGMA-Y SIGMA-XY"
DO 34 N=1,NE
A=0.0
B=0.0
CALL CALC
DO 30 I=1,4
K=NN(N,1)
ED(2*I-1)=Q(2*K-1)
ED(2*I)=Q(2*K)
CONTINUE
DO 32 I=1,3
ES(I)=0.0
DO 31 J=1,8
ES(I)=ES(I)+T(I,J)*ED(J)
CONTINUE
CONTINUE
WRITE(*,33) N,ES(1),ES(2),ES(3)
FORMAT(2X,I4,10X,3F10.4)
CONTINUE
STOP
END
SUBROUTINE CALC
DO 1 I=1,4
K=NN(N,I)
XY(I,1)=CO(K,1)
XY(I,2)=CO(K,2)
CONTINUE
DL(1,1)=(B-1)/4.0
DL(1,2)=(1-B)/4.0
DL(1,3)=(1+B)/4.0
DL(1,4)=-(1+B)/4.0
DL(2,1)=(A-1)/4.0
DL(2,2)=-(1+A)/4.0
DL(2,3)=(1+A)/4.0
DL(2,4)=(1-A)/4.0
DO 4 I=1,2
DO 3 J=1,2
TJ(I,J)=0.0
DO 2 K=1,4
TJ(I,J)=TJ(I,J)+DL(I,K)*XY(K,J)
CONTINUE
CONTINUE
CONTINUE
DJ=TJ(1,1)*TJ(2,2)-TJ(1,2)*TJ(2,1)
DD=TJ(1,1)
TJ(1,1)=TJ(2,2)/DJ
TJ(2,2)=DD/DJ
TJ(1,2)=-TJ(1,2)/DJ
TJ(2,1)=-TJ(2,1)/DJ
DO 7 I=1,2
DO 6 J=1,4
T(I,J)=0.0
DO 5 K=1,2
T(I,J)=T(I,J)+TJ(I,K)*DL(K,J)
CONTINUE
CONTINUE
CONTINUE
DO 9 I=1,3
DO 8 J=1,8
C(I,J)=0.0
CONTINUE
CONTINUE
DO 10 J=1,4
C(1,2*J-1)=T(1,J)
C(3,2*J)=T(1,J)
C(2,2*J)=T(2,J)
C(3,2*J-1)=T(2,J)
CONTINUE
DO 13 I=1,3
DO 12 J=1,8
T(I.J)=0.0
DO 11 K=1,3
T(I,J)=T(I,J)+D(I,K)*C(K,J)
CONTINUE
CONTINUE
RETURN
end program prog
پروژه سوم
کد:
program
!PROGRAM TO ANALYSE BEAMS AND FRAMES
!BY DR.J.RAAMACHANDRAN
DIMENSION ES(20,20),SS(100,100),Q(100),P(60)
DIMENSION NO(60,2),CO(40,2),PRS(32,5)
WRITE (*,*)"GIVE NO. OF NODES=NP,NO OF ELEMETS=NE,NO,OF BC=NB"
WRITE (*,*)"NO OF LOADED NODES=NI,NO OF PROPERTIES=NPR"
READ(*,*)NP,NE,NB,NL,NPR
NN=3*NP
DO 2 I=1,NN
Q (I)=0
DO 1 J=1,NN
SS (I,G)=0
CONTINUE
CONTINUE
WRITE (*,*)"GIVE YOUNG MODULUS=,AREA OF C/S=A,MOMENT OF INERTIA=I"
WRITE (*,*)"SELF WEIGHT=PY,APPLIED LOAD PER UNIT LENGTH=PN"
DO 3 I=1,NPR
READ (*,*)PRS(I,1),PRS(I,2),PRS(I,3),PRS(I,4),PRS(I,5)
CONTINUE
WRITE (*,*)"GIVE X AND Y NODAL COORDINATES"
DO 4 I=1,NP
READ(*,*) CO(I,1),CO(I,2)
CONTINUE
WRITE(*,*)"GIVE PROPERTY NUMBER AND CONNECTING NODES"
DO 5 I=1,NE
READ (*,*)P(I),NO(I,1),NO(I,2)
CONTINUE
DO 12N=1,NE
NI=NO(N,1)
NJ=NO(N,2)
DX=CO(NJ,1)-CO(NI,1)
DY=CO(NJ,2)-CO(NI,2)
EL=SQRT(DX*DX+DY*DY)
CA=DX/EL
SA=DY/EL
K=P(N)
E=PRS(K,1)
A=E*PRS(K,2)/EL
M=4*E*PRS(K,3)/EL
S=1.5*M/EL
ES(1,1)=A*CA*CA+2*S*SA*SA/EL
ES(1,2)=A*CA*SA-2*SA*S*CA/EL
ES(2,1)=ES(1,2)
ES(2,2)=A*SA*SA+2*S*CA*CA/EL
DO 6 I=1,2
DO 6 J=1,2
ES(I,J+3)=ES(I,J)
ES(I+3,J)=ES(I,J)
ES(I+3,J+3)=ES(I,J)
CONTINUE
ES(3,1)=S*SA
ES(3,2)=S*CA
ES(3,3)=M
ES(3,4)=S*SA
ES(3,5)=S*CA
ES(3,6)=M/2
DO 7 I=1,6
ES(I,3)=ES(3,I)
ES(I,6)=ES(3,I)
ES(6,I)=ES(3,I)
CONTINUE
ES(6,6)=M
ES(3,6)=M/2
ES(6,3)=ES(3,6)
FM=PRS(K,4)+CA*PRS(K,5)
Q(3*NI-1)=Q(3*NI-1)+FM*EL/2
Q(3*NJ-1)=Q(3*NJ-1)+FM*EL/2
FM=CA*PRS(K,4)+PRS(K,5)
Q(3*NI)=Q(3*NI)+FM*EL*EL/2
Q(3*NJ)=Q(3*NJ)-FM*EL*EL/2
FM=SA*PRS(K,5)*EL/2
Q(3*NI-2)=Q(3*NI-2)-FM
Q(3*NJ-2)=Q(3*NJ-2)-FM
DO 11 I=1,2
DO 10 J=1,2
DO 9 IL=1,3
IE=3*(I-1)+IL
NR=3*NO(N,I)-3+IL
DO 8 JL=1,3
JE=3*(J-1)+JL
NC=3*NO(N,J)-3+JL
SS(NR,NC)=SS(NR,NC)+ES(IE,JE)
CONTINUE
CONTINUE
CONTINUE
CONTINUE
CONTINUE
IF(NL.EQ.0)GOTO 14
WRITE(*,*)"GIVE NODE AND LOADS THEREIN:U,V,M"
DO 13 I=1,NL
READ (*,*) N,QU,QV,QM
Q(3*N-2)=Q(3*N-2)+QU
Q(3*N-1)=Q(3*N-1)+QV
Q(3*N)=Q(3*N)+QM
CONTINUE
WRITE(*,*)"CONDITIONS AT BOUNDARY NODES"
DO 16 I=1,NB
READ(*,*)N,NF
NF=3*N-3+NF
DO 15 J=1,NN
SS(NF,J)=0.0
CONTINUE
SS(NF,NF)=1.0
Q(NF)=0.0
CONTINUE
DO 20 I=1,NN
X=SS(I,I)
Q(I)=Q(I)/X
DO 17 J=I+1,NN
SS(I,J)=SS(I,J)/X
CONTINUE
DO 19 K=1,NN
IF(K.EQ.I)GOTO 19
X=SS(K,I)
Q(K)=Q(K)-X*Q(I)
DO 18 J=I+1,NN
SS(K,J)=SS(K,J)-X*SS(I,J)
CONTINUE
CONTINUE
CONTINUE
WRITE(*,*)"***********RESULTS************"
WRITE(*,*)"NODAL DISPLACEMENTS"
WRITE(*,*)"NODE U V ROTATION"
DO 21 I=1,NP
WRITE(*,*)I,Q(3*I-2),Q(3*I-1),Q(3*I)
CONTINUE
DO 22 N=1,NE
NI=NO(N,1)
NJ=NO(N,2)
K=P(N)
DX=CO(NJ,1)-CO(NI,1)
DY=CO(NJ,2)-CO(NI,2)
EL=SQRT(DX*DX+DY*DY)
CA=DX/EL
SA=DY/EL
UI=Q(3*NI-2)*CA+Q(3*NI-1)*SA
VI=Q(3*NI-2)*CA+Q(3*NI-1)*CA
UJ=Q(3*NI-2)*CA+Q(3*NJ-1)*CA
VJ=Q(3*NJ-2)*SA+Q(3*NJ-1)*CA
RI=Q(3*NI)
RJ=Q(3*NJ)
FM=PRS(K,4)*CA+PRS(K,5)
T=PRS(K,1)*PRS(K,2)*(UJ-UI)/EL
M=4*PRS(K,1)*PRS(K,3)/EL
S=1.5*M/EL
V=2*S/EL
FL=V*(VI-VJ)+S*(RI+RJ)-FM*EL/2
FR=V*(VI-VJ)-S*(RI+RJ)-FM*EL/2
FM=FM*EL*EL/12
ML=S*(VI-VJ)+M*(RI+RJ/2)-FM
MR=S*(VI-VJ)+M*(RI/2+RJ)+FM
WRITE(*,*) "ELEMENT",N
WRITE(*,*)"NODE :AXIAL :SHEAR :MOMENT"
WRITE(*,*)I
WRITE(*,*)NI
WRITE(*,*)T,FL,ML
WRITE(*,*)J
WRITE(*,*)NJ
WRITE(*,*) T,FR,MR
CONTINUE
STOP
end program
باز هم ممنونم
