精品文档

程序结构力学大作业

结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(:)

。 1欢迎下载

精品文档

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

。 2欢迎下载

精品文档

!================================== 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(:)

。 3欢迎下载