精品文档
程序结构力学大作业
结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欢迎下载