程序结构力学大作业

程序结构力学大作业 静力分析 动力分析

程序结构力学大作业

结81 孙玉进

该程序可计算任意平面结构任意阶频率（包括重频），以及任意阶振型（包括重频对应正交振型）。计算时，振型不包括不包括单元固端型振型。

!****************************

module NumKind

!***************

implicit none

integer (kind(1)),parameter :: ikind = kind(1), rkind = kind(0.D0)

real (rkind),parameter :: Zero = 0._rkind, One = 1._rkind, Two = 2._rkind, & Three= 3._rkind, Four = 4._rkind, Five = 5._rkind, &

Six = 6._rkind, Seven= 7._rkind, Eight = 8._rkind, &

Nine = 9._rkind, Ten =10._rkind, Twelve=12._rkind

end module NumKind

!**************

module TypeDef

!**************

use NumKind

implicit none

type :: typ_Joint

real (rkind) :: x,y

integer (ikind) :: GDOF(3)

end type typ_Joint

type :: typ_Element

integer (ikind) :: JointNo(2),GlbDOF(6)

real (rkind) :: Length,CosA,SinA,EI,EA,mass

end type typ_Element

type :: typ_JointLoad

integer (ikind) :: JointNo,LodDOF

real (rkind) :: LodVal

end type typ_JointLoad

type :: typ_ElemLoad

integer (ikind) ::ElemNo,Indx

real (rkind) :: Pos,LodVal

end type typ_ElemLoad

contains

!===================================

subroutine SetElemProp (Elem, Joint)

!===================================

type (typ_Element),intent(in out) :: Elem(:)

程序结构力学大作业 静力分析 动力分析

type (typ_Joint),intent(in) :: Joint(:)

integer(ikind)::ie,NElem

real(rkind)::x1,x2,y1,y2

NElem=size(Elem,dim=1)

do ie=1,NElem

x1=Joint(Elem(ie)%JointNo(1))%x

y1=Joint(Elem(ie)%JointNo(1))%y

x2=Joint(Elem(ie)%JointNo(2))%x

y2=Joint(Elem(ie)%JointNo(2))%y

Elem(ie)%Length=sqrt((x1-x2)**2+(y1-y2)**2)

Elem(ie)%CosA=(x2-x1)/Elem(ie)%Length

Elem(ie)%SinA=(y2-y1)/Elem(ie)%Length

Elem(ie)%GlbDOF(1:3)=Joint(Elem(ie)%JointNo(1))%GDOF(:)

Elem(ie)%GlbDOF(4:6)=Joint(Elem(ie)%JointNo(2))%GDOF(:)

end do

return

end subroutine SetElemProp

!======================================

subroutine TransMatrix (ET, CosA,SinA)

!======================================

real(rkind),intent(out) :: ET(:,:)

real(rkind),intent(in) :: CosA,SinA

! ET could be 2x2, 3x3 or 6x6 depending size(ET)

ET = Zero

ET(1,1:2) = (/ CosA, SinA /)

ET(2,1:2) = (/-SinA, CosA /)

if (size(ET,1) > 2) ET(3,3) = One

if (size(ET,1) > 3) ET(4:6,4:6) = ET(1:3,1:3)

return

end subroutine TransMatrix

end module TypeDef

!*************

module BandMat

!*************

use NumKind

use TypeDef,only : typ_Element ! 仅用该模块中的typ_Element

implicit none

private ! 默认所有的数据和过程为私有，增强封装性

public :: SetMatBand, DelMatBand, VarBandSolv

type,public :: typ_Kcol

real (rkind),pointer :: row(:)

end type typ_Kcol

contains

程序结构力学大作业 静力分析 动力分析

!==================================

subroutine SetMatBand (Kcol, Elem)

!==================================

! ...[6-4-2]

type (typ_KCol),intent(in out) :: Kcol(:)

type (typ_Element),intent(in) :: Elem(:)

integer (ikind) :: minDOF,ELocVec(6)

integer (ikind) :: ie,j,NGlbDOF,NElem

integer (ikind) :: row1(size(Kcol,dim=1))

! row1是自动数组，子程序结束后将自动释放内存空间

NGlbDOF = size(Kcol,1)

NElem = size(Elem,1)

row1 = NGlbDOF ! 先设始行码为大数

! 确定各列始行码，放在数组row1(:)中

do ie=1,NElem

ELocVec = Elem(ie)%GlbDOF

minDOF = minval (ELocVec,mask = ELocVec > 0)

where (ELocVec > 0)

row1(ELocVec) = min(row1(ELocVec), minDOF)

end where

end do

! 为各列的半带宽分配空间并初始化

do j=1,NGlbDOF

allocate ( Kcol(j)%row(row1(j):j) )

Kcol(j)%row = Zero ! 清零

end do

return

end subroutine SetMatBand

!===================================

subroutine DelMatBand (Kcol)

!===================================

!...[6-5-5]

type (typ_KCol), intent(in out) :: Kcol(:)

integer (ikind) :: j,NGlbDOF

NGlbDOF = size(Kcol,1)

do j=1,NGlbDOF

deallocate ( Kcol(j)%row )

end do

return

end subroutine DelMatBand

!=================================================

subroutine VarBandSolv (Disp, Kcol,GLoad)

!=================================================

type (typ_KCol), intent(in out) :: Kcol(:)

程序结构力学大作业 静力分析 动力分析

real (rkind), intent(out) :: Disp(:)

real (rkind), intent(in) :: GLoad(:)

integer (ikind) :: i,j,k,row1j,row_1,NCol

real(rkind) :: Diag(size(Kcol,dim=1))

real(rkind) ::s

!...[6-5-2]

NCol=size(Kcol,1)

Diag(1:NCol)=(/(Kcol(j)%row(j),j=1,NCol)/)

do j=2,NCol

row1j=lbound(Kcol(j)%row,1)

do i=row1j,j-1

row_1=max(row1j,lbound(Kcol(i)%row,1))

k=i-1

s= sum(Diag(row_1:k)*Kcol(i)%row(row_1:k)*Kcol(j)%row(row_1:k))

Kcol(j)%row(i)=(Kcol(j)%row(i)-s)/Diag(i)

end do

s=sum(Diag(row1j:j-1)*Kcol(j)%row(row1j:j-1)**2)

Diag(j)=Diag(j)-s

end do

Disp(:) = GLoad(:)

!...[ 6-5-3节的代码：其中GP换为Disp ]

do j=2,NCol

row1j=lbound(Kcol(j)%row,1)

Disp(j)=Disp(j)-sum(Kcol(j)%row(row1j:j-1)*Disp(row1j:j-1))

end do

!...[ 6-5-4节的代码：其中GP换为Disp ]

Disp(:)=Disp(:)/Diag(:)

do j=NCol,1,-1

row1j=lbound(Kcol(j)%row,1)

Disp(row1j:j-1)=Disp(row1j:j-1)-Disp(j)*Kcol(j)%row(row1j:j-1)

end do

return

end subroutine VarBandSolv

end module BandMat

!****************************

module DispMethod

!****************************

use NumK …… 此处隐藏：16595字，全部文档内容请下载后查看。喜欢就下载吧 ……