第1页 / 共18页
第2页 / 共18页
第3页 / 共18页
第4页 / 共18页
第5页 / 共18页
第6页 / 共18页
第7页 / 共18页
第8页 / 共18页
空间框架静力计算源程序_陆新征.pdf
程序诅明 g
1 ， 编程语言为 Fortran 90
2 ， 本程序可以求解任意空间杆革结构
3 节点位移编码为 ( X， Y, Z, 0 X, 0 Y飞。，) ， 荷载编码为 ( Fx， 町， 日， Mx, My, Mz )
4 单元输入信息为 。 起点号 ， 费点号 ， EA, EIy, EIz, Glx, Q (α 为参考坐标革与整体坐标革
夹角
5 ，程序为使编程简化 ， 果用了多文件技幸
程序清单g
程序由以下 四个文件组成
1: Lxz Tools . f90
2 : TypeDef . f90
3 : SolveDisp. f90
4 : 3dfr ame. f90
主要为一些工具函数
变盘定义 ， 单元属性分析
矩阵草解
整体控制精块
1: Lxz Tools . f90
module Lxz Tools
imp1icit Ilone
integer (kind( l ))，paramet町 ikilld=(kind(l ))
integer (kind( l 日，parameter : :rkind=(kind(O.DO))
real (rkind),
&
&
parameler :: Z臼o=O .DO ， Olle= I . DO ， Two=2. DO， Three= 3. DO， &
Four=4 .DO ，Five= 5.DO ， Six'二6.DO ， Sevell=7 . DO ， Eight= 8.DO ，Nine=9 .DO ， &
Tell=10.DO
cOlltams
fUllction ma l inv(A) 自治ult (B)
real(rkind) ,intenl (in) 剧，，)
!real(rkind) , allocatable::B(:,:)
k回 l(rkind) ， pointer::B(:,:)
illleger(ikind):: N ,1,J,K
1回 l(rkind): : D ，T
real(rkin吗， allocalable: :IS(:),JS(:)
N=size(A,dim=2)
allocale回归，N))
allocale(IS(N) ); a11 田 ate(JS(N))
B=A
do K= I ,N
D=O.ODO
doI=K,N
do J=K ，l'呼
叫abs(B(I，J))>D) Ihen
D~， b，(B(I， J))
IS(K)o'I
JSO王)~J
1
end if
enddo
enddo
doJ= 1
T~BO仪支立υ，1月)
B(K,JþBOS(K),J)
BOS (K)，J)~T
enddo
do I= LN
T~BO ，K)
BO，K)~BO，JS(K))
BO，JS (K))~T
enddo
B(K,Kþl lB(K,K)
do J= I,N
i f(J.NE.K) then
B(K，冉~B(K，J)咱(K ，K)
end if
enddo
do I= I,N
i f(l.NE.K) then
do J=I ,N
if(J.NE.K) then
BO，月二BO，J) 吕O， K) 'B (K，J)
巳nd if
enddo
end if
enddo
do I= LN
i f(l.NE.K) then
BO，Kþ-BO，K)咽(K， K)
end if
enddo
enddo
do K=N,l,-1
doJ= 1
T~BO仪ζζυ，1乃)
B(K,JþB(JS(K),J)
B(JS(K),JþT
enddo
do I= LN
T~BO ，K)
BO， K)~BO，l S (K))
BO,lS(K)þT
2
enddo
enddo
return
end 缸llctlon matlllv
subroutine IntSwap(a,b)
lllteg，巳r(ikind)，intent(in out): :a,b
integer(ikind): :t
t=a;a=b;b=t
end subroutine IntSwap
subroutine RealSwap(a,b)
real(rkin吗， intent(in out)::a,b
real(rkind):: t
t=a;a=b;b=t
end subroutine RealSwap
subroutine matprint(A,n)
real( rkind),intent(in): :A( :,:)
integer(ikind): :n
integer(ikind): :nl ,n2
lllteg，巳r(ikind): :ij
character( l O)::C
n l =size(A,dim= l )
n2=s ize(A，也n=2)
C='('lltrim(itoc (n2))//'E响 rim(itoc(n))lI&
'.'lItrim(it田 (n- 7)vrl'
do I= l ,nl
write(气C)(A(I，J)，J~ I ，n2)
巳nddo
end subroutine matprint
functÍon matdel但) result(det)
real( rkind) ， intent(川剧 ， )
real(rkind): :det
integer(ikind): :Il,ij ,k,isj s
real( rkind),pointer: :A(:,:)
k回 l(rkind) : : f， d， q
n=size(B,dim= l)
allocate (A(n,n))
A=B
f=1.0DO;
do k= l ,n-l
det= 1.0DO
q=O.ODO
3
do i=k,n
do j=k,n
if(
character(len=2): :c
real(rkind)::x
integer(ikind) ::n,b,ij
i=il
X=l
, (L2)oo"
x=log lO(x)
n=int(x:计2
doj=n-2,0,-1
b=mod(i, IO**j)
lFC;-b)l(1 0拿勺)
i=i-b气lO**j)
c(n-j -l : n 于 l)=ach叫iachar('O')+b)
enddo
end 也llctlon ltOC
subroutine Gauss(GStif,GLoad,GDisp)
real (rkind),intent (in):: GStif(: ,:),GLoad(:)
real (rkind),intent (out) :: GDisp(:)
i.llteger (ikind) :: ij ,k
mteg町 (ikind) :: N
real (rkind) :: P,Il,X ,Y
real (rki.r.l哟， allocatable :
N=size(GDisp,di.r.n= l)
allocate (A(N,N+ 1))
A(1 :N,1 :N)=GStif( 1 :N, I:N)
A( l ,N,N+ l }=GLo,d( l ,N)
00 j= I,N
P=O.ODO
: A(:,:)
OO k=j ,N
IF(ABS(A(kj )).LE.P) 'yde
P~AB S (A(kj ))
Il=k
enddo
IF(P.GE.I E-15)GO TO 230
WRITE (22 ，'(A川、m UNIQUE SOLUTION'
RETURN
IF(Il.EQ.j)GO TO 280
00 270 K=J,N+l
X~A(J ， K)
A(J,K)ooAOl ,K)
AOl ,K)ooX
Y= I .DO/A(J,J)
00 310 K=J,N+l
230
270
280
5
3 10
A(J，K)二Y拿A(J， K)
DO 380 I= l ,N
lF(lEQ .J)GO TO 380
Y~-A(I月
DO 370 K=J,N+ 1
A(I，K)~A(I ，K)+Y'A(J ， K)
370
380
390 enddo
CONllNUE
GDisp=A(l :N,N+ l )
end subroutine Gauss
end module Lxz Tools
2 : TypeDef . f90
include 'Lxz Tool5 . f90'
皿。 dule TypeDef
use Lxz Tools
implici t none
integer(ikind) ， par皿et 盯
NDOF=6 ，阳。 de =2
type : : typ_Joint
X, Y, Z
real (rkind)
integer(ikind)
end type typ_Joint
GDOF(NDOF)
JointNo(阳。 de)
type : : typ_Element
integer (ikind)
real {rkind} : El y, Elz, EA, Glp, Length, CosA, CosB, CosC, A
real (rkind} : :EK (NDOF*阳ode ， NDOF*NNode} ， ET (NDOF*NNode ， NDOF*阳ode}
integer(ikind) : :GlbDOF (NDOF*NNode)
real {rkind} : :EForce(NDOF*NNode) , ELForce (NDOF*NNode}
end type typ_Element
type: : typ_JointLoad
integer(ikind): :JointNo, LodDOF
real {rkind} : : LodVal
end type typ_JointLoad
type: : typ_ElemLoad
lnteger 归 kind) : : Ele~~o， Indx
real {rkind) : :Pos, LodVal
end type typ_ElemLoad
6
contalns
subroutine Set E le皿Pro p ( Elem， ]oint )
type (typ_Element ) , int ent ( inout ) : :E lem ( : )
type (typ_]oint ) , intent (i n) : : ]oint ( :)
integer (ikind)
i , E]1 , E]2
real (rkind) : : T (3, 3) , x, y, z
real (rkind)
do i =1, size (Elem)
: CX , cy, cz , cs , ca, sa
Elem (i )实主 K= zero;Elem ( i )%ET= zero;T= zero
E]l =Elem (i )%]ointNo ( l ) ;E]2=Elem (i )%]ointNo (2)
Elem ( i ) %G lbDOF ( 1 : 6) =]oint (E]1 ) 如回F (o)
Elem ( i ) %GlbDOF (7 : 12) =]oint (E]2) %GDOF ( : )
x=]oint (E]2)%X- ]oint (E] I )%X
y=]oint (E]2)%Y- ]oint (E] I )%Y
z=]oint (E]2)%Z- ]oint (E]1 )%Z
Elem ( i )%Length=sQrt (x**2+y**2+z**2)
Elem ( i ) %CosA=x! Elem (i )%Length
Elem ( i ) %CosB=y! Elem (i )%Length
Elem ( i ) %CosC=z! Elem (i )%Length
cx = Elem ( i ) %C osA;c y= Elem ( i ) 旺。 sB;cz = Elem ( i )%CosC
ca=cos (Elem ( i) %A) ; sa=sin (Elem ( i) %A)
cs = sQrt ( cx料 2+c y材 2)
i f (cs . NE. zero) then
T(l, 1) =cx; T(l, 2) =c y; T(l, 3) =cz
T (2, 1) =- (ca*cy+sa*cx*cz ) ! cs;
T (2, 2) = (ca*cx- sa*cy*cz ) ! cs
T (2, 3) =cs*sa
T (3, 1) = (sa*cy- ca*cx*cz ) ! cs;
T (3, 2) =- (sa*cx+ca*cy*cz ) ! cs
T (3, 3) =cs*ca;
else
T(l, 3) =one;
T (2, 1) =-sa;T (2, 2) =ca
T (3, 1) =-ca;T (3, 2) =-sa;
end i f
Elem (i )%ET (1 : 3, 1 : 3) =T; Elem(i )%ET (4 : 6, 4 : 6) =T;
Elem (i )%ET (7 : 9, 7 :9) =T; Elem(i )%ET (l O: 12, 10 : 12) =T;
T=zero
T ( 1, 1) =Elem (i )%EA!Elem (i )%Length
T (2, 2) =12DO*Elem ( i )%Elz! (Elem ( i )%Lengt h**3)
T (3, 3) =12DO*Elem ( i )%El y! (Elem ( i )%Length**3)
Elem (i )%EK (l : 3, 1 : 3) =T
Elem (i )%王 K ( 7 ， 9 ， 7 ， 9 ) =T
7
Elem ( i )%EK(1 : 3, 7 :9) =-T
Elem ( i )%EK(7 :9, 1 : 3) =transpose (- T)
T=zero
T (1 ， l) =Elem ( 。 如 Ip/ E lem ( i )%Len gt h
T(2, 2) =4DO*Elem (i )%El y/ Elem ( i )%Length
T(3, 3) =4DO*Elem (i )%Elz/ Elem ( i )%Length
Elem ( i )%EK(4 :6, 4 :6) =T; Elem (i )%EK(10 : 12, 10 : 12) =T
T=zero
T(2, 3) =6DO*Elem (i )%Elz/ (Elem (i )%Length**2)
T(3, 2) =-6DO*Elem ( i )%El y/ (Elem ( i )%Length**2)
Elem (i )%EK (1 : 3, 4 :6) =T; Elem (i )%EK (1 : 3, 10 : 12) =T
Elem ( i )%EK(4 :6, 1 : 3) =transpose (T)
Elem ( i) %EK (1 0 : 12, 1 : 3) =transpose (T)
Elem ( i )%EK(7 :9, 10 : 12) =-T
Elem ( i) 实主 K ( 10 : 12 ， 7: 9) =-transpose (T)
T=zero
T(2, 3) =6DO*Elem (i )%Ely/ (Elem (i )%Length**2)
T(3, 2) =-6DO*Elem ( i )%Elz/ (Elem ( i )%Length**2)
Elem (i )%王 K (4 ， 6， 7 ， 9 ) =T
Elem ( i )%EK(7 :9, 4 :6) =transpose (T)
T=zero
T ( I ， l) =-E lem ( i )%Glp /Elem (i)%正 en g th
T(2, 2) =2DO*Elem (i )%El y/ Elem ( i )%Length
T(3, 3) =2DO*Elem (i )%Elz/ Elem ( i )%Length
Elem ( i )%EK(4 :6, 10 : 12) =T
Elem ( i )%EK(10 : 12, 4 : 6) =t ranspose (T)
!call mat print(Elem (i )%EK, 10)
? 盯 i te (1 6 ，的 E lem (i )%ET
? 盯 i t e (筝，叫
end do
end subroutine SetElemProp
end module TypeDef
3 : SolveDisp . f90
include 'TypeDef. f90'
皿。 dule Sol ve
use TypeDef
t ype
t yp_Kcol
real (rkind) , pointer
ro时)
end t ype t yp_Kcol
contalns
subrout ine Sol veDisp (GDisp, Elem, ]oint, GLoad)
8
相关推荐
2023年江西萍乡中考道德与法治真题及答案.doc
2012年重庆南川中考生物真题及答案.doc
2013年江西师范大学地理学综合及文艺理论基础考研真题.doc
2020年四川甘孜小升初语文真题及答案I卷.doc
2020年注册岩土工程师专业基础考试真题及答案.doc
2023-2024学年福建省厦门市九年级上学期数学月考试题及答案.doc
2021-2022学年辽宁省沈阳市大东区九年级上学期语文期末试题及答案.doc
2022-2023学年北京东城区初三第一学期物理期末试卷及答案.doc
2018上半年江西教师资格初中地理学科知识与教学能力真题及答案.doc
2012年河北国家公务员申论考试真题及答案-省级.doc
2020-2021学年江苏省扬州市江都区邵樊片九年级上学期数学第一次质量检测试题及答案.doc
2022下半年黑龙江教师资格证中学综合素质真题及答案.doc
