| 查看: 1157 | 回复: 5 | |||
[交流]
Fortran平面桁架有限元程序
|
|||
|
program truss_2D use prep use solve implicit none integer :: i,j,m,n,nel,nne,nn,nodof,edof,gdof integer :: e2s(4) real :: L,FN real :: kl(4,4),kg(4,4),T(4,4) integer,allocatable :: elemNodes (:,:) ,nf(:,:) real ,allocatable :: Coords (:,:),prop(:,:), & KK(:,:),loads(:,:) real ,allocatable :: nodedisp(:,:),F(:) ,edg(:), & fg(:),fl(:),delta(:) open ( 10,file = 'data.txt' ) open ( 11,file = 'out.txt' ) read (10,*) nel ! Number of elements read (10,*) nne ! Number of nodes per element allocate ( elemNodes(nel,nne),prop(nel,nne) ) read (10,*) nn ! Number of nodes read (10,*) nodof ! Number of degrees of freedom per node edof = nodof * nne allocate ( Coords(nn,nodof),nf(nn,nodof), & loads(nn,nodof),nodedisp(nn,nodof),edg(edof), & fg(edof),fl(edof) ) read (10,*) ( (elemNodes(i,j), j=1,nne), i=1,nel ) read (10,*) ( (prop(i,j), j=1,nne), i=1,nel ) read (10,*) ( (Coords(i,j), j=1,nodof), i=1,nn ) read (10,*) ( (nf(i,j), j=1,nodof), i=1,nn ) read (10,*) ( (loads(i,j), j=1,nodof), i=1,nn ) gdof = 0 do i = 1,nn do j = 1,nodof if ( nf(i,j)/=0 ) then gdof = gdof + 1 nf(i,j) = gdof end if end do end do allocate ( KK(gdof, gdof), F(gdof),delta(gdof) ) F = 0. call truss_F( m,n,nn,nodof,nf,gdof,loads,F) e2s = 0 KK = 0. do i = 1,nel call truss_T(i,nel,nne,nn,nodof,elemNodes,Coords,L,T) call truss_kl (i,nel,nne,L,prop,kl) call truss_kg (T,kl,kg) call truss_e2s(i,j,nn,nel,nne,nodof,nf,elemNodes,e2s) call form_KK (m,n,edof,gdof,kg,e2s,KK) end do call fem_Solver(KK,F,gdof,delta) ! 求解 nodedisp = 0. forall ( i = 1:nn,j = 1:nodof,nf(i,j)/=0 ) nodedisp(i,j) = delta( nf(i,j) ) end forall do i = 1,nel call truss_T(i,nel,nne,nn,nodof,elemNodes,Coords,L,T) call truss_kl (i,nel,nne,L,prop,kl) call truss_kg (T,kl,kg) call truss_e2s(i,j,nn,nel,nne,nodof,nf,elemNodes,e2s) edg = 0. do j = 1,edof if ( e2s(j) /= 0 ) then edg(j) = delta( e2s(j) ) end if end do fg = matmul( kg,edg ) fl = matmul( T,fg ) FN = fl(3) write (11,100) i write (11,200) FN end do 100 format (/,T10,'单元',I2 ) 200 format (T10,'轴力=',F18.4) end program truss_2D |
» 猜你喜欢
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有3人回复
E0414, 我的本子有没有希望?
已经有9人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有3人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有3人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有3人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有4人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有3人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有3人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有4人回复
售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急
已经有5人回复
» 抢金币啦!回帖就可以得到:
硫化物 / 氧化物 / 卤化物全拆解:固态电池手套箱选型核心指南
+1/82
青年拔尖人才还有指标 25w*8年
+1/74
Cu2O纳米线
+5/70
东南大学有机多孔功能材料团队(国家杰青团队)招收2027级推夏令营免硕士/直博生
+1/33
湖南师范大学(211)—招收2026年入学的“申请-考核”制博士(有微纳光学经验者优先)
+1/24
澳大利亚西澳大学招收交通工程/智能交通方向博士生
+1/16
重庆大学金属塑性成形方向招收2027年博士研究生(学博)
+2/16
求助最新版ISO 5817
+1/12
上海大学微电子学院杨军教授团队招聘带编专任教师
+1/10
墨尔本大学(26年QS19)招全奖博士/CSC博士(补齐全奖)等-材料/生物电子/器官芯片等
+1/8
化学识别核酸的综述投稿
+1/6
美国普渡大学(Purdue University)生物化学系招聘博士后
+1/6
密苏里大学生物材料合成生物学博士后招聘
+1/6
密苏里大学生物材料合成生物学博士后招聘
+1/6
【外资CRO招聘】医药相关专业--新药研发临床试验岗 | 北京/上海 | 多岗位热招中
+1/4
请问下国内的中文EI学报有哪些投稿周期比较快的
+1/4
哈尔滨工业大学(深圳)赵怡潞课题组诚招博士后、2027学年博士生
+1/3
上海大学微电子学院杨军教授团队招聘带编专任教师
+1/3
计算化学博士后研究员招聘
+1/2
密苏里大学生物材料合成生物学博士后招聘
+1/2
简单回复
dsctg2楼
2017-02-24 11:48
回复
springer_(金币+1): 谢谢参与
2017-02-24 14:30
回复
springer_(金币+1): 谢谢参与
是 发自小木虫IOS客户端
2017-11-10 23:54
回复
2018-01-11 19:19
回复
springer_(金币+1): 谢谢参与
是 发自小木虫Android客户端
2018-01-27 19:42
回复
springer_(金币+1): 谢谢参与
顶 发自小木虫IOS客户端











回复此楼