📄 程序trus3.txt
字号:
程序TRUS3
1：C -------------TRUS3.FOR-----------------
2：C --FORCES IN PIN JOINTED SPACE TRUSSES--
3：C CHARACTER*12 FALE
4： INTEGER*2 LI（1000）
5： REAL*4 A（10000）
6： WRITE（*，’（A）’）’ INPUT DATA FILE NAME：’
7： READ（*，’（A12）’）FALE
8： OPEN（7，FILE=FALE，STATUS=’OLD’）
9： READ（7，*）NJ，MS，NF，NC
10： WRITE（*，’（/4X，4A6/4X，4I6/）’）
11： $ ’NJ’，’MS’，’NF’，NC’，NJ，MS，NF，NC
12： N3=NJ*3
13： N=N3-NF
14： iu=1
15: iaa=iu+n3
16: iea=iaa+ms
17: ix=iea+ms
18: iy=ix+nj
19: iz=iy+nj
20: isq=iz+nj
21: ish=isq+3
22: idc=ish+3
23: ist=idc+3
24: mal=ist+36
25: jia=1
26: jja=jia+ms
27: jns=jja+ms
28: nal=jns+2*nf
29: na=10000-mal
30: nli=1000-nal
31: CALL TRUS3(A(IU),A(IAA),A(IEA),A(IX),
32: $ A(IY),A(IZ),A(ISQ),A(ISH),A(IDC),
33: $ A(IST),A(MAL),LI(NAL),LI(JIA),LI(JJA),
34: $ LI(JNS),NJ,MS,NF,NC,N3,N,NA,NLI)
35: CLOSE(7)
36: STOP
37: END
38:C ----------------------------------------
39: SUBROUTINE TRUS3(U,AA,EA,X,Y,Z,SQ,SH,
40: $ DC,ST,A,LI,IA,JA,NS,NJ,MS,NF,NC,
41: $ N3,N,NA,NLI)
42: INTEGER*2 IA(MS),JA(MS),NS(NF,2),LI(NLI)
43: REAL*4 U(N3),AA(MS),EA(MS),X(NJ),Y(NJ),
44:* $ Z(NJ),SQ(3),SH(3),DC(3),ST(6,6),A(NA)
45: READ(7,*)(X(I),Y(I),Z(I),I=1,NJ),
46: $ (NS(I,1),NS(I,2),I=1,NF),
47: $ (IA(I),JA(I),AA(I),EA(I),I=1,MS)
48: WRITE(*,’(/4X,A)’)’NODAL COORDINATES’
49: WRITE(*,’(4X,A4,3A12)’)’NO.’,’X-COOR.’,
50: $ ’Y-COOR.’，’Z-COOR.’
51： WRITE(*,’(4X,I4,3F12.3)’)
52: $ (I,X(I),Y(I),Z(I),I=1,NJ)
53: WRITE(*,’(/4X,A)’)
54: $ ’POINT OF SUPPRESSED DISPLACEMENTS’
55： WRITE(*,’(2A8/(2I8))’)’NO.’,
56: $ ’DIRECTON’，(NS(I,1),NS(I,2),I=1,NF)
57: WRITE(*,’(/4X，A)’)’MEMBER DETAILS’
58: WRITE(*,’(4X，A4,A6,A4,2A12/
59: $ (3X,’’(’’,I3,’’)’’,I6,’’-’’,I2,
60: $ 2F12.3))’)’NE.’，’I’，’-J’，’A’，’E’，
61： $ (I,IA(I),JA(I),AA(I),EA(I),I=1,MS)
62: MX=0
63: DO 400 I=1,MS
64: IO=IABS(JA(I)-IA(I))
65: IF(IO.GT.MX)MX=IO
66:400 CONTINUE
67: NW=(MX+1)*3
68: NT=N3+NW
69: iia=1
70: iq=iia+nt*nw
71: ic=iq+nt
72: iqd=ic+nt
73: mal=iqd+nc+na
74: jjod=1
75: nal=jjod+2*nc+nli
76: CALL S410(U,AA,EA,X,Y,Z,SQ,SH,
77: $ DC,ST,A(IIA),A(IQ),A(IC),A(IQD),
78: $LI(JJOD),IA,JA,NS,NJ,MS,NF,NC,N3,N,NW,NT)
79: RETURN
80: END
81:C ----------------------------------------
82: SUBROUTINE S410(U,AA,EA,X,Y,A,SQ,SH,
83: $ DC,ST,A,Q,C,QD,JOD,IA,JA,NS,NJ,MS,
84: $ NF,NC,N3,N,NW,NT)
85: INTEGER*2 IA(MS),JA(MS),NS(NF,2),
86: $ JOD(NC,2)
87: REAL*4 U(N3),AA(MS),EA(MS),X(NJ),Y(NJ),
88: $ Z(NJ),SQ(3),SH(3),DC(3),ST(6,6),
89: $ A(NT,NW),Q(NT),C(NT),QD(NC),L
90: DO 480 I=1,NT
91: DO 450 J=1,NW
92: 450 A(I,J)=0.0
93: 480 Q(I)=0.0
94: READ(7,*)
95: (JOD(I,1),JOD(I,2),QD(I),I=1,NC)
96: WRITE(*,’(/4X,A)’)’EXTERNAL LOADS’
97: WRITE(*,’(A10,3X,A10,A13/
98: $ (2I10,F16.3))’)’NO.’,
99: $ ’DIRECTION’，’VALUE’，(JOD(I,1),
100: $ JOD(I,2),QD(I),I=1,NC)
101: DO 544 I=1,NC
102: NP=JOD(I,1)*3+JOD(I,2)-3
103:544 Q(NP)=Q(NP)+QD(I)
104: DO 1120 ME=1,MS
105: I=IA(ME)
106: J=JA(ME)
107: AO=AA(ME)
108: E=EA(ME)
109: L=SQRT((X(J)-X(I))**2
110: $ +(Y(J)-Y(I))**2+(Z(J)-Z(I))**2)
111: XC=(X(J)-X(I))/L
112: YC=(Y(J)-Y(I))/L
113: ZC=(Z(J)-Z(I))/L
114: ST(1,1)=XC**2
115: ST(1,2)=XC*YC
116: ST(2,1)=ST(1,2)
117: ST(2,2)=YC**2
118: ST(1,3)=XC*ZC
119： ST(3,1)=ST(1,3)
120: ST(3,2)=YC*ZC
121: ST(2,3)=ST(3,2)
122: ST(3,3)=ZC**2
123: ST(4,1)=-XC**2
124: ST(4,2)=-XC*YC
125: ST(4,3)=-XC*ZC
126: ST(5,1)=-XC*YC
127: ST(5,2)=-YC**2
128: ST(5,3)=-YC*ZC
129: ST(6,1)=-XC*ZC
130: ST(6,2)=-YC*ZC
131: ST(6,3)=-ZC**2
132: DO 870 II=1,3
133: DO 870 JJ=1,3
134: ST(II+3,JJ+3)=ST(II,JJ)
135:870 ST(II,JJ+3)=ST(JJ+3,II)
136: CN=AO*E/L
137: DO 930 II=1,6
138: DO 930 JJ=1,6
139:930 ST(II,JJ)=ST(II,JJ)*CN
140: I1=3*I-3
141: J1=3*J-3
142: DO 1114 JJ=1,2
143: IF(JJ.EQ.1)NR=I1
144: IF(JJ.EQ.2)NR=J1
145: DO 1112 J9=1,3
146: NR=NR+1
147: II=(JJ-1)*3+J9
148: DO 1110 KK=1,2
149: IF(KK.EQ.1)N9=I1
150: IF(KK.EQ.2)N9=J1
151: DO 1100 K=1,3
152: LL=(KK-1)*3+K
153: NK=N9+K+1-NR
154: IF(NK.LE.0)GO TO 1100
155: A(NR,NK)=A(NR,NK)+ST(II,LL)
156:1100 CONTINUE
157:1110 CONTINUE
158:1112 CONTINUE
159:1114 CONTINUE
160:1120 CONTINUE
161: DO 1150 I=1,NF
162: NP=NS(I,1)*3+NS(I,2)-3
163: A(NP,1)=A(NP,1)*1E+12+1E+12
164:1150 A(NP)=0
165: N=N3
166: DO 1190 II=1,N3
167:1190 C(II)=Q(II)
168: CALL S2000(A,C,N,NW,NT)
169:1220 DO 1230 II=1,N3
170:1230 U(II)=C(II)
171: WRITE(*,’(/4X,A)’)’NODAL DISPLACEMENTS’
172: WRITE(*,’(A8，A10，2A12/（I8，3F12.4）)’)
173： $ ’NO.’，’U’，’V’，’W’，
174： $(II,U(3*II-2),U(3*II-1),U(3*II),II=1,NJ
175: WRITE(*,’（/4X，A）’)
176： $ ’FORCES IN THE MEMBERS’
177： WRITE（*，’（4X，A4，A8，A4，A16）’）
178： $ ’NE’，’I’，’-J’，’FORCE’
179： DO 1610 ME=1，MS
180： I=IA（ME）
181： J=JA（ME）
182： AO=AA（ME）
183： E=EA（ME）
184： L=SQRT（（X（J）-X（I））**2
185： $ +(Y(J)-Y(I))**2+(Z(J)-Z(I))**2)
186: XC=(X(J)-X(I))/L
187: YC=(Y(J)-Y(I))/L
188: ZC=(Z(J)-Z(I))/L
189: DC(1)=XC
190: DC(2)=YC
191: DC(3)=ZC
192: I1=3*I-3
193: J1=3*J-3
194: DO 1510 I3=1,3
195: J3=I1+I3
196: J2=J1+I3
197: SQ(I3)=U(J3)
198:1510 SH(I3)=U(J2)
199: A1=0
200: A2=0
201: DO 1570 II=1,3
202: A1=A1+DC(II)*SQ(II)
203:1570 A2=A2+DC(II)*SH(II)
204: FC=AO*E*(A2-A1)/L
205: WRITE(*,’(4X,’’(’’,’’)’’,I6,
206: $ ’’-’’，I2，F16.5)’)
207: $ ME,IA(I),JA(I),FC
208:1610 CONTINUE
209: RETURN
210: END
211:C ---------------------------------------------
212: SUBROUTINE S2000(A,CC,N,NW,NT)
213: REAL*4 A(NT,NW),CC(NT)
214:2000 DO 2940 II=1,N
215: IK=II
216: DO 2920 JJ=2,NW
217: IK=IK+1
218: CN=A(II,JJ)/A(II,1)
219: JK=0
220: DO 2890 KK=JJ,NW
221: JK=JK+1
222:2890 A(IK,JK)=A(IK,JK)-CN*A(II,KK)
223: A(II,JJ)=CN
224:2920 CC(IK)=CC(IK)-CN*CC(II)
225:2940 CC(II)=CC(II)/A(II,1)
226: DO 3010 IZ=2,N
227: II=N-IZ+1
228: DO 3000 KK=2,NW
229: JJ=II+KK-1
230:3000 CC(II)=CC(II)-A(II,KK)*CC(JJ)
231:3010 CONTINUE
232: RETURN
233: END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -