程序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，F(xiàn)ILE=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，F(xiàn)16.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