程序结构力学大作业

程序结构力学大作业结81孙玉进该程序可计算任意平面结构任意阶频率（包括重频），以及任意阶振型（包括重频对应正交振型）。计算时，振型不包括不包括单元固端型振型。!****************************moduleNumKind!***************implicitnoneinteger(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._rkindendmoduleNumKind!**************moduleTypeDef!**************useNumKindimplicitnonetype::typ_Jointreal(rkind)::x,yinteger(ikind)::GDOF(3)endtypetyp_Jointtype::typ_Elementinteger(ikind)::JointNo(2),GlbDOF(6)real(rkind)::Length,CosA,SinA,EI,EA,massendtypetyp_Elementtype::typ_JointLoadinteger(ikind)::JointNo,LodDOFreal(rkind)::LodValendtypetyp_JointLoadtype::typ_ElemLoadinteger(ikind)::ElemNo,Indxreal(rkind)::Pos,LodValendtypetyp_ElemLoadcontains!===================================subroutineSetElemProp(Elem,Joint)!===================================type(typ_Element),intent(inout)::Elem(:)type(typ_Joint),intent(in)::Joint(:)integer(ikind)::ie,NElemreal(rkind)::x1,x2,y1,y2NElem=size(Elem,dim=1)doie=1,NElemx1=Joint(Elem(ie)%JointNo(1))%xy1=Joint(Elem(ie)%JointNo(1))%yx2=Joint(Elem(ie)%JointNo(2))%xy2=Joint(Elem(ie)%JointNo(2))%yElem(ie)%Length=sqrt((x1-x2)**2+(y1-y2)**2)Elem(ie)%CosA=(x2-x1)/Elem(ie)%LengthElem(ie)%SinA=(y2-y1)/Elem(ie)%LengthElem(ie)%GlbDOF(1:3)=Joint(Elem(ie)%JointNo(1))%GDOF(:)Elem(ie)%GlbDOF(4:6)=Joint(Elem(ie)%JointNo(2))%GDOF(:)enddoreturnendsubroutineSetElemProp!======================================subroutineTransMatrix(ET,CosA,SinA)!======================================real(rkind),intent(out)::ET(:,:)real(rkind),intent(in)::CosA,SinA!ETcouldbe2x2,3x3or6x6dependingsize(ET)ET=ZeroET(1,1:2)=(/CosA,SinA/)ET(2,1:2)=(/-SinA,CosA/)if(size(ET,1)2)ET(3,3)=Oneif(size(ET,1)3)ET(4:6,4:6)=ET(1:3,1:3)returnendsubroutineTransMatrixendmoduleTypeDef!*************moduleBandMat!*************useNumKinduseTypeDef,only:typ_Element!仅用该模块中的typ_Elementimplicitnoneprivate!默认所有的数据和过程为私有，增强封装性public::SetMatBand,DelMatBand,VarBandSolvtype,public::typ_Kcolreal(rkind),pointer::row(:)endtypetyp_Kcolcontains!==================================subroutineSetMatBand(Kcol,Elem)!==================================!...[6-4-2]type(typ_KCol),intent(inout)::Kcol(:)type(typ_Element),intent(in)::Elem(:)integer(ikind)::minDOF,ELocVec(6)integer(ikind)::ie,j,NGlbDOF,NEleminteger(ikind)::row1(size(Kcol,dim=1))!row1是自动数组，子程序结束后将自动释放内存空间NGlbDOF=size(Kcol,1)NElem=size(Elem,1)row1=NGlbDOF!先设始行码为大数!确定各列始行码，放在数组row1(:)中doie=1,NElemELocVec=Elem(ie)%GlbDOFminDOF=minval(ELocVec,mask=ELocVec0)where(ELocVec0)row1(ELocVec)=min(row1(ELocVec),minDOF)endwhereenddo!为各列的半带宽分配空间并初始化doj=1,NGlbDOFallocate(Kcol(j)%row(row1(j):j))Kcol(j)%row=Zero!清零enddoreturnendsubroutineSetMatBand!===================================subroutineDelMatBand(Kcol)!===================================!...[6-5-5]type(typ_KCol),intent(inout)::Kcol(:)integer(ikind)::j,NGlbDOFNGlbDOF=size(Kcol,1)doj=1,NGlbDOFdeallocate(Kcol(j)%row)enddoreturnendsubroutineDelMatBand!=================================================subroutineVarBandSolv(Disp,Kcol,GLoad)!=================================================type(typ_KCol),intent(inout)::Kcol(:)real(rkind),intent(out)::Disp(:)real(rkind),intent(in)::GLoad(:)integer(ikind)::i,j,k,row1j,row_1,NColreal(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)/)doj=2,NColrow1j=lbound(Kcol(j)%row,1)doi=row1j,j-1row_1=max(row1j,lbound(Kcol(i)%row,1))k=i-1s=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)enddos=sum(Diag(row1j:j-1)*Kcol(j)%row(row1j:j-1)**2)Diag(j)=Diag(j)-senddoDisp(:)=GLoad(:)!...[6-5-3节的代码：其中GP换为Disp]doj=2,NColrow1j=lbound(Kcol(j)%row,1)Disp(j)=Disp(j)-sum(Kcol(j)%row(row1j:j-1)*Disp(row1j:j-1))enddo!...[6-5-4节的代码：其中GP换为Disp]Disp(:)=Disp(:)/Diag(:)doj=NCol,1,-1row1j=lbound(Kcol(j)%row,1)Disp(row1j:j-1)=Disp(row1j:j-1)-Disp(j)*Kcol(j)%row(row1j:j-1)enddoreturnendsubroutineVarBandSolvendmoduleBandMat!****************************moduleDispMethod!****************************useNumKinduseTypeDefuseBandMatimplicitnonecontains!========================subroutineSolveDisp(Disp,Elem,Joint,JLoad,ELoad)!========================real(rkind),intent(out)::Disp(:)type(typ_Element),intent(in)::Elem(:)type(typ_Joint),intent(in)::Joint(:)type(typ_JointLoad),intent(in)::JLoad(:)type(typ_Elemload),intent(in)::ELoad(:)type(typ_Kcol),allocatable::Kcol(:)real(rkind),allocatable::GLoad(:)integer(ikind)::NGlbDOFNGlbDOF=size(Disp,dim=1)allocate(GLoad(NGlbDOF))allocate(Kcol(NGlbDOF))callSetMatBand(Kcol,Elem)callGLoadVec(GLoad,Elem,JLoad,ELoad,Joint)callGStifMat(Kcol,Elem)callVarBandSolv(Disp,Kcol,GLoad)callDelMatBand(Kcol)deallocate(GLoad)returnendsubroutineSolveDisp!========================subroutineGStifMat(Kcol,Elem)!========================type(typ_Kcol),intent(inout)::Kcol(:)type(typ_Element),intent(in)::Elem(:)!...[6-4-3]integer(ikind)::ie,j,JGDOF,NE