【跪求】弹性地基梁的源程序

wangqIAN_17

谁有晓东cad家园的帐号帮我下一个弹性地基梁的bas程序
是bas文件 2k大小
我 试着注册 了 几次都没有成功
http://www.xdcad.net/forum/showthread.php?postid=1060668、

[ 本帖最后由 wangqIAN_17 于 2007-12-31 17:08 编辑 ]

wangqIAN_17

自己顶！
西挖能够有人帮忙！
我的邮箱
wangqian_17@163.com

wangqIAN_17

我找到了！与大家共享！
1 REM  "G-2-2"
2 CLEAR : LPRINT "** ";
3 LPRINT "弹性地基梁计算程序(G-2-2)";
4 LPRINT " **"
5 OPEN "I",#1,"G-2-2.DAT"
40 INPUT #1, R,N,LM,L,E0,E,U,B
42 INPUT #1, NH: DIM X(NH),H(NH)
43 FOR I1=1 TO NH: INPUT #1, X(I1),H(I1): NEXT I1
45 DIM Z(R,4),AK(N+2),Y(N),D(N+2),B1(N+2)
47 DIM F((N+2)*(N+3)/2),X2(N*(N+1)/2)
50 FOR I=1 TO R: FOR J=1 TO 4: INPUT #1, Z(I,J): NEXT J: NEXT I
55 INPUT #1, RL: IF RL=0 THEN 65
60 DIM PL(RL),AL(RL): FOR I=1 TO RL: INPUT #1, PL(I),AL(I): NEXT I
65 INPUT #1, RR: IF RR=0 THEN 75
70 DIM PR(RR),AR(RR): FOR I=1 TO RR: INPUT #1, PR(I),AR(I): NEXT I
75 INPUT #1, U0
76 INPUT "需要打印原始数据吗 (Y/N)";G$
80 IF G$="N" OR G$="n" THEN 152
85 LPRINT "原始数据:"
90 LPRINT "地基的压缩模量 E0=";E0;"(KN/m?)"
95 LPRINT "梁的弹性模量   E=";E;"(KN/m?)"
100 LPRINT "梁的泊松比 U=";U; "梁宽 B=";B;"(m)"
105 IF NH=1 THEN 113
107 LPRINT : LPRINT TAB(2);"X(m)";TAB(11);"梁高H(m)"
108 X(0)=0 : FOR I=1 TO NH: LPRINT TAB(1);X(I-1);"-";X(I);TAB(14);H(I)
110 NEXT I: LPRINT : GOTO 115
113 LPRINT "梁高 H=";H;"(m)"
115 LPRINT TAB(1);"梁长L=";L;"(m)"
116 LPRINT TAB(1);"分段数N=";N;TAB(13);"荷载个数R=";R
120 LPRINT TAB(1);"问题类型(空间/平面/文克勒尔(1/2/3))LM=";LM
122 LPRINT "梁上荷载要素:"
125 LPRINT TAB(2);"Z(I,1)";TAB(11);"Z(I,2)";TAB(20);"Z(I,3)";TAB(29);"Z(I,4)"
127 FOR I=1 TO R: LPRINT TAB(1);Z(I,1);TAB(10);Z(I,2);TAB(19);Z(I,3);TAB(28);Z(I,4)
129 NEXT I: LPRINT
130 IF RL=0 THEN 135
131 LPRINT "边荷载要素:"
132 LPRINT TAB(2);"左PL(I)";TAB(11);"AL(I)"
133 FOR I=1 TO RL: LPRINT TAB(1)L(I);TAB(10);AL(I):NEXT I: LPRINT
135 IF RR=0 THEN 140
136 LPRINT TAB(2);"右PR(I)";TAB(11);"AR(I)"
138 FOR I=1 TO RR: LPRINT TAB(1);PR(I);TAB(10);AR(I):NEXT I: LPRINT
140 LPRINT "U0=";U0;"(地基泊松比,文氏问题为梁下可压缩层厚度)
145 LPRINT "- - - - - - - - -":
152 IF LM<>2 THEN 165
154 INPUT "按平面应力/平面应变计算 (L/B)";A$
156 IF A$="L" OR A$="l" THEN LPRINT "按平面应力计算":GOTO 165
158 IF A$="B" OR A$="b" THEN LPRINT "按平面应变计算":GOTO 160
159 GOTO 154
160 E=E/(1-U^2):U=U/(1-U):E0=E0/(1-U0^2):U0=U0/(1-U0)
165 C=L/N: FOR K=1 TO N
170 AK(K)=(K-.5)*C:S=0
175 FOR I=1 TO R:T=Z(I,4): ON T GOTO 180,185
180 P1=Z(I,1):B2=Z(I,2): GOSUB 1740:S=S-P1*S1: GOTO 350
185 P1=Z(I,1)*(Z(I,3)-Z(I,2))1=(Z(I,3)+Z(I,2))/2
190 I1=1: IF AK(K)>Z(I,2) THEN 205
192 M1=L1-X(I1-1):M3=AK(K)-X(I1-1):JK=E*B*H(I1)^3/12
195 IF AK(K)>X(I1) THEN 200
197 M2=L1-AK(K):S=S-P1*(2*M1*M3+M2*M3)*M3/6/JK: GOTO 350
200 M2=L1-X(I1):M4=AK(K)-X(I1):S=S-P1*(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
202 I1=I1+1: GOTO 192
205 IF AK(K)>Z(I,3) THEN 295
210 IF X(I1)>Z(I,2) THEN 225
212 M1=L1-X(I1-1):M2=L1-X(I1):M3=AK(K)-X(I1-1):M4=AK(K)-X(I1):JK=E*B*H(I1)^3/12
215 S=S-P1*(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
220 I1=I1+1: GOTO 210
225 IF X(I1-1)>=Z(I,2) THEN 265
230 M1=L1-X(I1-1):M2=L1-Z(I,2):M3=AK(K)-X(I1-1):M4=AK(K)-Z(I,2)
231 JK=E*B*H(I1)^3/12
235 S=S-P1*(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
240 IF X(I1)<=AK(K) THEN 250
245 A1=Z(I,2):A2=AK(K): GOSUB 1900:S=S-Z(I,1)*S2/JK: GOTO 350
250 A1=Z(I,2):A2=X(I1): GOSUB 1900:S=S-Z(I,1)*S2/JK
255 IF X(I1)=AK(K) THEN 350
260 I1=I1+1
265 JK=E*B*H(I1)^3/12
270 IF X(I1)<=AK(K) THEN 280
275 A1=X(I1-1):A2=AK(K): GOSUB 1900:S=S-Z(I,1)*S2/JK: GOTO 350
280 A1=X(I1-1):A2=X(I1): GOSUB 1900:S=S-Z(I,1)*S2/JK
285 IF X(I1)=AK(K) THEN 350
290 I1=I1+1: GOTO 265
295 IF X(I1)>Z(I,2) THEN 315
300 M1=L1-X(I1-1):M2=L1-X(I1):M3=AK(K)-X(I1-1):M4=AK(K)-X(I1):JK=E*B*H(I1)^3/12
305 S=S-P1*(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
310 I1=I1+1: GOTO 295
315 IF X(I1-1)>=Z(I,2) THEN 337
320 M1=L1-X(I1-1):M2=L1-Z(I,2):M3=AK(K)-X(I1-1):M4=AK(K)-Z(I,2)
321 JK=E*B*H(I1)^3/12
323 S=S-P1*(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
325 IF X(I1)<=Z(I,3) THEN 330
327 A1=Z(I,2):A2=Z(I,3): GOSUB 1900:S=S-Z(I,1)*S2/JK: GOTO 350
330 A1=Z(I,2):A2=X(I1): GOSUB 1900:S=S-Z(I,1)*S2/JK
332 IF X(I1)=Z(I,3) THEN 350
335 I1=I1+1
337 JK=E*B*H(I1)^3/12: IF X(I1)>Z(I,3) THEN 348
340 A1=X(I1-1):A2=X(I1): GOSUB 1900:S=S-Z(I,1)*S2/JK
342 IF X(I1)=Z(I,3) THEN 350
345 I1=I1+1: GOTO 337
347 S=S-AK(K)^2*Z(I,1)/(2*E*JK)
348 A1=X(I1-1):A2=Z(I,3): GOSUB 1900:S=S-Z(I,1)*S2/JK
350 NEXT I
351 IF LM=3 THEN 355
352 IF RL<>0 THEN 540
354 IF RR<>0 THEN 580
355 S=S+SL+SR
360 D(K)=-S:Y(K)=S
370 NEXT K
380 S=0=0
390 FOR I=1 TO R
400 T=Z(I,4)
410 ON T GOTO 420,430,450
420 S=S+Z(I,1):Q=Q+Z(I,1)*Z(I,2): GOTO 460
430 S=S+Z(I,1)*(Z(I,3)-Z(I,2))
440 Q=Q+Z(I,1)*(Z(I,3)-Z(I,2))*(Z(I,2)+(Z(I,3)-Z(I,2))/2): GOTO 460
450 Q=Q+Z(I,1)
460 NEXT I
470 D(N+1)=-S(N+2)=-Q
480 FOR K=1 TO N
485 FOR I=1 TO K
490 IF I>K THEN 530
495 B2=AK(I): GOSUB 1740
500 F(K*(K-1)/2+I)=S1
510 X2(K*(K-1)/2+I)=F(K*(K-1)/2+I)
520 NEXT I
530 NEXT K: GOTO 645
540 T=LM: ON T GOTO 545,560,570
545 SL=0: FOR I=1 TO RL:X=AL(I)+AK(K): GOSUB 1800
550 SL=SL+PL(I)*S0*(1-U0^2)/ 3.141592654 /E0/C: NEXT I
555 GOTO 570
560 SL=0:ST=2* LOG (100*L/C)+2+ LOG (2)
562 FOR I=1 TO RL:X=AL(I)+AK(K): GOSUB 1850
565 S0=ST+S0:SL=SL+PL(I)*S0/ 3.141592654 /E0/B: NEXT I
570 GOTO 354
580 T=LM: ON T GOTO 585,600,610
585 SR=0: FOR I=1 TO RR:X=AR(I)+L-AK(K): GOSUB 1800
590 SR=SR+PR(I)*S0*(1-U0^2)/ 3.141592654 /E0/C: NEXT I
595 GOTO 610
600 SR=0:ST=2* LOG (100*L/C)+2+ LOG (2)
602 FOR I=1 TO RR:X=AR(I)+L-AK(K): GOSUB 1850
605 S0=ST+S0:SR=SR+PR(I)*S0/ 3.141592654 /E0/B: NEXT I
610 GOTO 355
645 T=LM
650 ON T GOTO 660,730,820
660 Q=(1-U0^2)/( 3.141592654 *E0*C)
665 FOR K=1 TO N
670 IF K-1<1 THEN 700
675 FOR I=1 TO K-1
680 X=AK(K)-AK(I): GOSUB 1800
685 S=S0
690 F(K*(K-1)/2+I)=F(K*(K-1)/2+I)+S*Q
695 NEXT I
700 S= SQR (C^2/B^2+1):S=B* LOG (C/B+S)/C+ LOG (1+S)
705 F(K*(K+1)/2)=F(K*(K+1)/2)+2*C*( LOG (B/C)+S)*Q/B
710 NEXT K
720 GOTO 860
730 Q=1/( 3.141593 *E0*B)
740 FOR K=1 TO N
745 IF K-1<1 THEN 800
750 FOR I=1 TO K-1
760 X=AK(K)-AK(I): GOSUB 1850
770 S=S0
780 F(K*(K-1)/2+I)=F(K*(K-1)/2+I)+S*Q
790 NEXT I
800 NEXT K
810 GOTO 860
820 Q=U0/(E0*B*C)
830 FOR K=1 TO N
840 F(K*(K+1)/2)=F(K*(K+1)/2)+Q
850 NEXT K
860 FOR I=1 TO N
870 F((N+1)*N/2+I)=-1
880 F((N+2)*(N+1)/2+I)=-AK(I)
890 NEXT I
900 F((N+1)*(N+2)/2)=0
910 F((N+1)*(N+4)/2)=0
920 F((N+2)*(N+3)/2)=0
940 N1=N+2
980 FOR I=1 TO N+2
990 B1(I)=D(I)
1000 NEXT I
1010 GOSUB 1520
1020 DIM QK(N),MK(N)
1030 FOR K=1 TO N
1040 QK(K)=0:MK(K)=0
1050 FOR I=1 TO R
1060 T=Z(I,4)
1070 ON T GOTO 1080,1100,1180
1080 IF AK(K)>=Z(I,2) THEN 1090
1085 GOTO 1200
1090 MK(K)=MK(K)-(AK(K)-Z(I,2))*Z(I,1):QK(K)=QK(K)-Z(I,1): GOTO 1200
1100 IF AK(K)>Z(I,2) THEN 1120
1110 GOTO 1200
1120 IF AK(K)<Z(I,3) THEN 1160
1130 QK(K)=QK(K)-Z(I,1)*(Z(I,3)-Z(I,2))
1140 MK(K)=MK(K)-Z(I,1)*(Z(I,3)-Z(I,2))*(AK(K)-(Z(I,2)+Z(I,3))/2)
1150 GOTO 1200
1160 QK(K)=QK(K)-Z(I,1)*(AK(K)-Z(I,2))
1170 MK(K)=MK(K)-Z(I,1)*(AK(K)-Z(I,2))^2/2: GOTO 1200
1180 IF AK(K)>Z(I,2) THEN MK(K)=MK(K)+Z(I,1)
1200 NEXT I
1205 NEXT K
1210 FOR K=1 TO N
1220 S=0:Q=0
1230 FOR I=1 TO N
1240 IF I>K THEN Y(K)=X2(I*(I-1)/2+K)*B1(I)+Y(K): GOTO 1260
1250 Y(K)=X2(K*(K-1)/2+I)*B1(I)+Y(K)
1260 NEXT I
1265 Y(K)=B1(N+1)+AK(K)*B1(N+2)-Y(K)
1267 IF K-1<1 THEN 1300
1270 FOR I=1 TO K-1
1280 S=S+B1(I):Q=Q+B1(I)*(AK(K)-AK(I))
1290 NEXT I
1300 QK(K)=QK(K)+S+.5*B1(K)
1310 MK(K)=MK(K)+Q+C*B1(K)/8
1315 NEXT K
1320 FOR K=1 TO N
1330 D(K)=B1(K)/C
1340 NEXT K
1350 LPRINT TAB(2);"X(m)";TAB(9);"反力D(kN/m?)";TAB(23);"弯距M(kN-m)";TAB(36);"剪力Q(kN)";TAB(49);"变位Y(cm)"
1360 FOR I=1 TO N
1370 LPRINT TAB(1); INT (100*(I-.5)*C+.5)/100;TAB(8); INT (100*D(I)+.5)/100;
1372 LPRINT TAB(23); INT (100*MK(I)+.5)/100;TAB(36); INT (100*QK(I)+.5)/100;
1373 LPRINT TAB(49); INT (100*(Y(I)*100)+.5)/100
1375 NEXT I
1378 GOTO 1710
1380 LPRINT "     THE END":
1420 END
1500 G1=2*X/C+1
1520 DIM C1(N1-1)
1525 FOR I=1 TO N1
1527 IF I-1<1 THEN 1567
1530 I1=I*(I-1)/2
1535 FOR J=1 TO I-1
1540 S=0:J1=J*(J-1)/2:J2=J*(J+1)/2
1543 IF J-1<1 THEN 1560
1545 FOR K=1 TO J-1
1550 S=S+C1(K)*F(J1+K)
1555 NEXT K
1560 C1(J)=F(I1+J)-S:F(I1+J)=C1(J)/F(J2)
1565 NEXT J
1567 S=0:I2=I*(I+1)/2
1568 IF I-1<1 THEN 1585
1570 FOR K=1 TO I-1
1575 S=S+C1(K)*F(I1+K)
1580 NEXT K
1585 F(I2)=F(I2)-S
1590 NEXT I
1595 FOR I=1 TO N1
1600 I1=I*(I-1)/2:S=0
1603 IF I-1<1 THEN 1625
1605 FOR K=1 TO I-1
1610 S=S+F(I1+K)*B1(K)
1615 NEXT K
1620 B1(I)=B1(I)-S
1625 NEXT I
1630 FOR I=1 TO N1
1635 I2=I*(I+1)/2:B1(I)=B1(I)/F(I2)
1640 NEXT I
1645 FOR I=N1 TO 1 STEP -1
1647 IF I+1>N1 THEN 1668
1650 S=0
1655 FOR K=I+1 TO N1
1660 S=S+F(K*(K-1)/2+I)*B1(K)
1663 NEXT K
1667 B1(I)=B1(I)-S:D(I)=B1(I)/C
1668 NEXT I
1700 RETURN
1710 GOTO 1380
1740 S1=0:I1=1: IF AK(K)>=B2 THEN 1770
1745 M1=B2-X(I1-1):M3=AK(K)-X(I1-1):JK=E*B*H(I1)^3/12
1750 IF X(I1)>AK(K) THEN 1765
1755 M2=B2-X(I1):M4=AK(K)-X(I1):S1=S1+(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
1758 IF X(I1)=AK(K) THEN 1790
1760 I1=I1+1: GOTO 1745
1765 M2=B2-AK(K):S1=S1+(2*M1*M3+M2*M3)*(M1-M2)/6/JK
1768 GOTO 1790
1770 M1=B2-X(I1-1):M3=AK(K)-X(I1-1):JK=E*B*H(I1)^3/12
1772 IF X(I1)>B2 THEN 1785
1775 M2=B2-X(I1):M4=AK(K)-X(I1):S1=S1+(2*M1*M3+2*M2*M4+M1*M4+M2*M3)*(M1-M2)/6/JK
1780 IF X(I1)=B2 THEN 1790
1782 I1=I1+1: GOTO 1770
1785 M4=AK(K)-B2:S1=S1+(2*M1*M3+M1*M4)*(M3-M4)/6/JK
1790 RETURN
1800 G1=2*X/C+1:G2=2*X/C-1
1805 G3=2*X/B:G4=G3-C/B:G3=G3+C/B
1810 S0=2* LOG (B/C)- LOG (G1*G2)-2*X/C* LOG (G1/G2)
1815 G2= SQR (G3^2+1):G1= SQR (G4^2+1)
1820 S0=S0+B* LOG ((G3+G2)/(G4+G1))/C
1825 S0=S0+2*X* LOG ((1+G2)/(1+G1))/C
1830 S0=(S0+ LOG ((1+G2)*(1+G1)))/B*C
1835 RETURN
1850 G1=2*X/C+1
1855 S0=2*X/C-1:S0=-2*X* LOG (G1/S0)/C- LOG (G1*S0)
1860 RETURN
1900 S2=AK(K)*Z(I,3)^2*(A2-A1)/2-Z(I,3)*(2*AK(K)+Z(I,3))*(A2^2-A1^2)/4
1905 S2=S2+(AK(K)+2*Z(I,3))*(A2^3-A1^3)/6-(A2^4-A1^4)/8
1910 RETURN