应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » Fortran平面桁架有限元程序
61/1返回列表
查看: 1157  |  回复: 5
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看

springer_

木虫 (著名写手)

[交流] 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
回复此楼

» 猜你喜欢

» 抢金币啦！回帖就可以得到:

查看全部散金贴
1楼 2017-02-24 11:45:14
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
简单回复
dsctg2楼
2017-02-24 11:48   回复  
springer_(金币+1): 谢谢参与
jixiangbao3楼
2017-02-24 14:30   回复  
springer_(金币+1): 谢谢参与
是 发自小木虫IOS客户端
werewolves4楼
2017-11-10 23:54   回复  
springer_(金币+1): 谢谢参与
发自小木虫Android客户端
1401022405楼
2018-01-11 19:19   回复  
springer_(金币+1): 谢谢参与
是 发自小木虫Android客户端
hxdtj20146楼
2018-01-27 19:42   回复  
springer_(金币+1): 谢谢参与
顶 发自小木虫IOS客户端
相关版块跳转 我要订阅楼主 springer_ 的主题更新
61/1返回列表
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[教师之家] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 oepdf5z972 2026-06-20 3/150 2026-06-21 21:01 by zo4669e5n4
[基金申请] E0414, 我的本子有没有希望？ +7 布布和一二 2026-06-17 9/450 2026-06-21 19:29 by 布布和一二
[考研] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 9skg9htng1 2026-06-20 3/150 2026-06-21 19:18 by q1p9ixelzp
[教师之家] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 9skg9htng1 2026-06-20 3/150 2026-06-21 18:58 by q1p9ixelzp
[公派出国] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 9skg9htng1 2026-06-20 3/150 2026-06-21 18:00 by q1p9ixelzp
[考研] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 9skg9htng1 2026-06-20 4/200 2026-06-21 17:45 by q1p9ixelzp
[论文投稿] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 9skg9htng1 2026-06-20 3/150 2026-06-21 17:40 by q1p9ixelzp
[论文投稿] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 9skg9htng1 2026-06-20 3/150 2026-06-21 17:37 by q1p9ixelzp
[公派出国] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +4 vlfdw50o0u 2026-06-20 4/200 2026-06-21 17:25 by ky8v3skvft
[考博] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +4 vlfdw50o0u 2026-06-20 5/250 2026-06-21 17:20 by ky8v3skvft
[博后之家] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +4 vlfdw50o0u 2026-06-20 6/300 2026-06-21 17:05 by ky8v3skvft
[公派出国] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +4 vlfdw50o0u 2026-06-20 5/250 2026-06-21 17:00 by ky8v3skvft
[论文投稿] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +3 vlfdw50o0u 2026-06-20 5/250 2026-06-21 16:45 by ky8v3skvft
[教师之家] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +4 vlfdw50o0u 2026-06-20 7/350 2026-06-21 16:40 by ky8v3skvft
[论文投稿] 售T0P一区SCI文章，我:8O5.51.O.54,科目齐全,可＋急 +4 vlfdw50o0u 2026-06-20 9/450 2026-06-21 16:37 by ky8v3skvft
[基金申请] 青A35岁以下通知答辩了吗 +3 暨阳一只柴 2026-06-17 3/150 2026-06-21 09:39 by kudofaye
[考博] 【全奖博士/科研助理/博后招生】新加坡南洋理工大学机械与航空航天学院 +3 robohaha 2026-06-15 4/200 2026-06-21 00:36 by lanbing1
[基金申请] 希望面上有个好结果 +7 碧水00 2026-06-16 7/350 2026-06-18 12:18 by wuke100666
[论文投稿] 三区计算机方向期刊推荐 +5 1457340941 2026-06-15 5/250 2026-06-17 13:16 by 会议编辑
[论文投稿] sci论文二审求助 +5 潘倍倍 2026-06-15 5/250 2026-06-16 10:15 by xs74101122
信息提示
关闭
请填处理意见
关闭