| 查看: 1109 | 回复: 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 |
» 猜你喜欢
体制内长辈说体制内绝大部分一辈子在底层,如同你们一样大部分普通教师忙且收入低
已经有12人回复
过年走亲戚时感受到了所开私家车的鄙视链
已经有9人回复
今年春晚有几个节目很不错,点赞!
已经有10人回复
情人节自我反思:在爱情中有过遗憾吗?
已经有10人回复
基金正文30页指的是报告正文还是整个申请书
已经有5人回复
» 抢金币啦!回帖就可以得到:
山东征女友,坐标济南
+1/165
大连海事大学轮机学院尚有博士名额
+2/60
一个陌生女人的来信
+1/59
海法大学线上开放日
+1/33
国家级青年人才课题组招收2026级硕士研究生
+1/30
2026年天津科技大学“新能源催化与膜材料团队”研究生招生
+1/17
代朋友发 88公务员诚征男友
+1/17
太原理工大学集成电路学院招收2026年博士研究生
+1/6
武汉纺织大学全国重点实验室陈嵘教授团队招收硕士研究生
+1/6
香港科技大学(广州)微电子学域助理教授招募全奖博士生与研究助理(纳米器件)
+1/6
招收2026年入学博士研究生
+1/5
天津医科大学基础医学院张恒课题组博士后招聘
+1/5
南昌大学资源与环境学院刘进教授团队招收2026硕博研究生
+1/5
全奖博士 英国利物浦大学+台湾清华大学 双博士学位
+1/5
深圳大学26级土木工程博士招生
+1/4
内江师范学院能源转化与储能实验室诚聘博士1-2人
+1/4
26申博自荐求博导-生物传感分析方向
+1/3
大学教授诚征结婚女友@坐标长春
+1/1
澳科大诚招2026年秋季硕士研究生(药物递送/生物材料方向,3月5日18:00报名截止)
+1/1
澳洲皇家墨尔本理工RMIT招收大模型安全/隐私PhD
+1/1
简单回复
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客户端













回复此楼