线弹性小变形平面刚架静力有限元计算程序Word文件下载.docx
《线弹性小变形平面刚架静力有限元计算程序Word文件下载.docx》由会员分享，可在线阅读，更多相关《线弹性小变形平面刚架静力有限元计算程序Word文件下载.docx（35页珍藏版）》请在冰点文库上搜索。
kna5=knode*1
if（kna5/2*2.lt.kna5）kna5=kna5+1
knb4=kelem*1
if（knb4/2*2.lt.knb4）knb4=knb4+1
knb2=kvar1*1
if（knb2/2*2.lt.knb2）knb2=knb2+1
knb3=kvar1*1
if（knb3/2*2.lt.knb3）knb3=knb3+1
kna0=1
kna1=kna1+kna0
kna2=kna2+kna1
kna3=kna3+kna2
kna4=kna4+kna3
kna5=kna5+kna4
if（kna5-1.gt.250000000）then
exceedmemoryofarrayia'
memoryofia=250000000'
memoryneeded='
kna5,'
inprgramstart'
stop55555
endif
knb0=1
knb1=knb1+knb0
knb2=knb2+knb1
knb3=knb3+knb2
knb4=knb4+knb3
if（knb4-1.gt.125000000）then
exceedmemoryofarrayib'
memoryofib=125000000'
knb4,'
callstart（knode,kdgof,kcoor,kvar,
*kelem,maxt,kvar1,ia（kna0）,ia（kna1）,ia（kna2）,
*ia（kna3）,ia（kna4）,ib（knb0）,ib（knb1）,ib（knb2）,
*ib（knb3）,
*filename）
end
subroutinestart（knode,kdgof,kcoor,kvar,
*kelem,maxt,kvar1,u0,u1,u2,
*coor,inodvar,nodvar,numcol,lm,node,
character*12filename（20）
DIMENSIONNODVAR（KDGOF,KNODE）,COOR（KCOOR,KNODE）,R（3）,
*U0（KDGOF,KNODE）,U1（KDGOF,KNODE）,U2（KDGOF,KNODE）,
*INODVAR（KNODE）,node（kelem）
DIMENSIONNUMCOL（KVAR1）,LM（KVAR1）
CHARACTER*1MATERIAL
logicalfilflg
C.................................................................
C.....KDGOFNUMBEROFD.O.F
C.....KNODENUMBEROFNODES
C.....INODVARIDDATA
C.....NODVARDENOTETHEEQUATIONNUMBERCORRESPONDINGTHED.O.F
C.....U0U1U2INITIALVALUE
C.....COORCOORDINATES
C.....NODEELEMENTNODALCONNECTION
6FORMAT（1X,15I4）
7FORMAT（1X,8F9.3）
C.......OPENIDfile
OPEN（1,FILE='
FORM='
UNFORMATTED'
STATUS='
OLD'
READ
（1）NUMNOD,NODDOF,（（NODVAR（I,J）,I=1,NODDOF）,J=1,NUMNOD）
CLOSE
（1）
callchms（kdgof,knode,NODVAR）
cWRITE（*,*）'
NUMNOD='
NUMNOD,'
NODDOF='
NODDOF
cWRITE（*,*）'
ID='
cWRITE（*,6）（（NODVAR（I,J）,I=1,NODDOF）,J=1,NUMNOD）
C.....GETTHENATURALNODALORDER
DO12N=1,KNODE
INODVAR（N）=N
12CONTINUE
C.....OPENORDER.NODFILEANDREADTHENODALORDERIFTHEFILEEXIST
inquire（file='
ORDER.NOD'
exist=filflg）
if（filflg）then
READ
（1）（INODVAR（I）,I=1,NUMNOD）
CLOSE
（1）
WRITE（*,*）'
NODORDER='
WRITE（*,6）（INODVAR（I）,I=1,NUMNOD）
C.....GETNVBYID
NEQ=0
DO20JNOD=1,NUMNOD
J=INODVAR（JNOD）
DO18I=1,NODDOF
IF（NODVAR（I,J）.NE.1）GOTO18
NEQ=NEQ+1
NODVAR（I,J）=NEQ
18CONTINUE
20CONTINUE
DO30JNOD=1,NUMNOD
DO28I=1,NODDOF
IF（NODVAR（I,J）.GE.-1）GOTO28
N=-NODVAR（I,J）-1
NODVAR（I,J）=NODVAR（I,N）
28CONTINUE
30CONTINUE
C.....OPENANDWRITETHENVFILE
OPEN（8,STATUS='
unknown'
FILE='
FORM='
WRITE（8）（（NODVAR（I,J）,I=1,NODDOF）,J=1,NUMNOD）
CLOSE（8）
cWRITE（*,6）（（NODVAR（I,J）,I=1,NODDOF）,J=1,NUMNOD）
C....WRITETHEBOUNDAYCONDITIONFILEBFDACCORDINGTOTHEDISP0FILE
C....OPENDISP0FILE
OPEN（1,FILE='
READ
（1）NUMNOD,NODDOF,（（U0（I,J）,I=1,NODDOF）,J=1,NUMNOD）
C....OPENBFDFILE
WRITE
（1）（（U0（I,J）,I=1,NODDOF）,J=1,NUMNOD）
C......GETTHEINITIALTIMEFROMTIME0FILE
C.......OPENTIME0File
FORMATTED'
READ（1,*）T0,TMAX,DT
TIME=T0
IT=0
TMAX,DT,TIME,IT='
TMAX,DT,TIME,IT
C.......OPENTIMEFile
WRITE
（1）TMAX,DT,TIME,IT
C.......OPENCOORfile
READ
（1）NUMNOD,NCOOR,（（COOR（I,J）,I=1,NCOOR）,J=1,NUMNOD）
COOR='
cWRITE（*,7）（（COOR（I,J）,I=1,NCOOR）,J=1,NUMNOD）
C......GETTHEINITIALVALUEFROMTHEDATAFILESBYPREPROCESSOR
disp1'
open（16,file='
status='
old'
read（16）numnod,noddof,（（U0（J,N）,J=1,NODDOF）,N=1,NUMNOD）
close（16）
disp2'
read（16）numnod,noddof,（（U1（J,N）,J=1,NODDOF）,N=1,NUMNOD）
disp3'
read（16）numnod,noddof,（（U2（J,N）,J=1,NODDOF）,N=1,NUMNOD）
U0='
cWRITE（*,'
（6F13.3）'
）（（U0（J,N）,J=1,NODDOF）,N=1,NUMNOD）
CWRITE（*,*）'
U1='
CWRITE（*,'
）（（U1（J,N）,J=1,NODDOF）,N=1,NUMNOD）
C......COMPUTETHEINITIALVALUEBYBOUND.FOR
zo=0.0d0
cDO321N=1,NUMNOD
cDO100J=1,NCOOR
c100R（J）=COOR（J,N）
cDO200J=1,NODDOF
cU0（J,N）=BOUND（R,zo,J）
cU1（J,N）=BOUND1（R,zo,J）
cU2（J,N）=BOUND2（R,zo,J）
c200CONTINUE
c321CONTINUE
C.......OPENANDWRITETHEINITIALVALUEFILEUNOD
WRITE
（1）（（U0（I,J）,J=1,NUMNOD）,I=1,NODDOF）,
*（（U1（I,J）,J=1,NUMNOD）,I=1,NODDOF）,
*（（U2（I,J）,J=1,NUMNOD）,I=1,NODDOF）,
*（（U0（I,J）,J=1,NUMNOD）,I=1,NODDOF）
c....openIOfile
open（21,file='
formatted'
read（21,'
（1a）'
）material
read（21,*）numtyp
close（21）
DOI=1,NEQ
NUMCOL（i）=1
ENDDO
C.......OPENELEM0file
OPEN（3,FILE='
NUMEL=0
KELEM=0
KEMATE=0
DO2000ITYP=1,NUMTYP
C.......INPUTENODE
READ（3）NUM,NNODE,
*（（NODE（（I-1）*NNODE+J）,J=1,NNODE）,I=1,NUM）
ccWRITE（*,*）'
NUM='
NUM,'
NNODE='
NNODE
NODE='
ccWRITE（*,6）（（NODE（（I-1）*NNODE+J）,J=1,NNODE）,I=1,NUM）
IF（KELEM.LT.NUM*NNODE）KELEM=NUM*NNODE
NNE=NNODE
IF（MATERIAL.EQ.'
Y'
.OR.MATERIAL.EQ.'
y'
）THEN
READ（3）MMATE,NMATE
IF（KEMATE.LT.MMATE*NMATE）KEMATE=MMATE*NMATE
NNE=NNE-1
ENDIF
MMATE='
MMATE,'
NMATE='
NMATE
DO1000NE=1,NUM
L=0
DO700INOD=1,NNE
NODI=NODE（（NE-1）*NNODE+INOD）
DO600IDGF=1,KDGOF
INV=NODVAR（IDGF,NODI）
IF（INV.LE.0）GOTO600
L=L+1
LM（L）=INV
600CONTINUE
700CONTINUE
NUMEL=NUMEL+1
CWRITE（*,*）'
L,LM='
L
CWRITE（*,'
（1X,15I5）'
）（LM（I）,I=1,L）
if（l.gt.0）callACLH（NEQ,NUMCOL,l,lm）
1000continue
2000CONTINUE
cCLOSE
（1）
CLOSE（3）
callBCLH（NEQ,NUMCOL）
MAXA=NUMCOL（NEQ）
C.......OPENSYSFile
OPEN（2,FILE='
WRITE
（2）NUMEL,NEQ,NUMTYP,MAXA,KELEM,KEMATE
CLOSE
（2）
OPEN（2,FILE='
write
（2）（NUMCOL（I）,I=1,NEQ）
CLOSE
（2）
cwrite（*,*）'
NEQ,NUMCOL='
NEQ
cwrite（*,6）（NUMCOL（i）,i=1,NEQ）
END
subroutinechms（kdgof,knode,id）
dimensionid（kdgof,knode）,ms（1000）,is（1000）
do1000k=1,kdgof
m=0
do800n=1,knode
if（id（k,n）.le.-1）id（k,n）=-1
if（id（k,n）.le.1）goto800
j=id（k,n）
j0=0
if（m.gt.0）then
doi=1,m
if（j.eq.ms（i））j0=is（i）
enddo
if（j0.eq.0）then
m=m+1
ms（m）=j
is（m）=n
id（k,n）=1
else
id（k,n）=-j0-1
800continue
return
SUBROUTINEACLH（NEQ,NUMCOL,ND,LM）
DIMENSIONLM（ND）,NUMCOL（NEQ）
LS=LM
（1）+1
DO100I=1,ND
110IF（LM（I）-LS）120,100,100
120LS=LM（I）
100CONTINUE
DO200I=1,ND
II=LM（I）
ME=II-LS
IF（ME.GT.NUMCOL（II））NUMCOL（II）=ME
200CONTINUE
RETURN
SUBROUTINEBCLH（NEQ,NUMCOL）
DIMENSIONNUMCOL（NEQ）
CNUMCOL
（1）=1
DO490I=2,NEQ
490NUMCOL（I）=NUMCOL（I）+NUMCOL（I-1）+1
3.ebeam2da.for，Galerkin法求解位移场的主程序
common/cc/ic（62500000）
MAXT=250000000/2/2
read
（2）NUMEL,NEQ,NUMTYP,MAXA,KELEM,KEMATE
IF（MAXA.GT.MAXT）THEN
MATRIXAEXCEEDCOREMEMERY....'
MAXA
REQUIREDCOREMEMERY...........'
MAXT
STOP0000
KVAR=KNODE*KDGOF
KCOOR=3
CKELEM=31250000
KNODE,KDGOF,KVAR,KCOOR,KELEM='
WRITE（*,'
（1X,6I7）'
）KNODE,KDGOF,KVAR,KCOOR,KELEM
kna1=kdgof*knode*1
if（kna1/2*2.lt.kna1）kna1=kna1+1
knc1=kdgof*knode*2
knc2=kcoor*knode*2
knc7=kdgof*knode*2
knc3=neq*2
knb1=maxa*2
knb2=maxa*2
kna2=neq*1
if（kna2/2*2.lt.kna2）kna2=kna2+1
knc6=kemate*2
kna3=kelem*1
if（kna3/2*2.lt.kna3）kna3=kna3+1
knc8=100000*2
knc5=neq*2
knc4=kdgof*knode*2
if（kna3-1.gt.125000000）then
kna3,'
inprgramebeam2da'
if（knb2-1.gt.250000000）then
excee
升级会员 