سلام دوستان عزیز 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
باز هم ممنونم
پاسخ با نقل قول