Программа s3_3.F

parameter(NDFG=6,NCNM=3,NSTM=18,NP=6,NE=4

* ,NDF=6,NB=2,NBAND=24,IMAX=36,NSZF=36,NCN=3)

* пофазное формирование глобальной матрицы инертности

dimension nop(ne,ncnm),estifm(nstm,nstm),

* cord(np,3),rq(nszf),nbc(nb),nfix(nb),

* s(nszf),a(imax,nband),

* npr(nszf),n pr1(nszf),ndis(nszf)

open(16,file='RES3_3')

open(1,file='AGLM',form='unformatted')

open(9,file='NOP')

read(9)nop,cord

close(9)

open(13,file='DTE2',form='unformatted')

do 445 n=1,nb

445 read(13,*)nbc(n),nfix(n)

close(13)

WRITE(16,9)(NBC(I),NFIX(I),I=1,NB)

Продолжение приложения 3

9 FORMAT(2i8)

call FRMEG(imax,nband,nszf,ne,ndfg,ncnm,

* nop,estifm,nstm,a,nb,nfix,nbc,ndis,knul)

call CORR(a,imax,nband,nszf,nszf1,ndis,knul,ik)

end file(16)

close(16)

close(1)

close(2)

stop

end

Программа s4_3.F

* пофазное решение проблемы собственных значений

parameter(neig=6,nit=200,test=1.e-05,nszf1=20

* ,nszf=36,imx=20,nband=24,knul=16)

dimension np(nszf1),np1(nszf1),am(imx,nband),d(nszf1)

* ,x(nszf1),y(nszf1),ask(imx,nband),b(nszf1,neig),xp(nszf)

* ,ndis(nszf),s(nband),bm(neig),bl(neig)

open(16,file='Res4_3')

open(1,file='NDIS',form='unformatted')

read(1)ndis

end file(1)

close(1)

call FCTF(IMX,nband,NSZF1,np,NP1,Ask,D,i5)

call EIGF(nszf1,ask,d,am,x,y,b,xp,knul,nszf,ndis,imx,i5

* ,nband,s

* ,neig,nit,test,bm,bl)

print * ' end EIGF'

print *

end file(16)

close(16)

stop

end

Приложение4

ПРОГРАММА Brus_d.f

dimension cord(100,3),nop(144,4),nop4(24,8),nbc(50),nfix(50),

*rq(300)

c формирование массивов nop,cord для бруса

open(1,file='BRS')

open(2,file='DT0',form='unformatted')

read(2,*)np,nszf,ne4,ne,nb,nq

ncn=4

ndf=3

c стойка с одним защемленным концом

write(1,*)' стойка x(a)=0.1m y(b)=0.1m z(h)=2.5m '

do 22 i=1,np

22 read(2,*)cord(i,1),cord(i,2),cord(i,3)

do 33 n=1,ne4

33 read(2,*)(nop4(n,j),j=1,8)

do 330 n=1,ne4

330 write(1,*)(nop4(n,j),j=1,8)

do 331 i=1,nb

331 read(2,*)nbc(i),nfix(i)

do 3 j=1,nszf

3 rq(j)=0.

do 332 i=1,nq

332 read(2,*)nq1,rq(nq1)

close(2)

call TETR(nop4,nop,ne,ne4)

write(1,*)' nop'

do 4 n=1,ne

4 write(1,41)n,(nop(n,i),i=1,4)

41 format(i6,4i5)

write(1,*)' cord'

do 5 n=1,np

5 write(1,51)n,(cord(n,i),i=1,3)

51 format(i6,3f10.2)

open(2,file='NOP',form='unformatted')

write(2)nop,cord,rq,nbc,nfix

end file(2)

close(2)

end file(1)

close(1)

stop

end

Продолжение приложения 4 программа s1.F

* вычисление и запись локальных матриц жесткости

* элементов (тетраэдров)

* массивы nop и cord сформированы ранее и считываются из файла 10

dimension cord(100,3),nop(144,4),estifm(12,12)

open(1,file='RES1')

open(8,FILE='ESTIFM',form='unformatted')

open(12,file='B',form='unformatted')

open(10,file='NOP',form='unformatted')

read(10)nop,cord

close(10)

open(2,file='DT1',form='unformatted')

read(2,*)ne,np,em,pr

end file(2)

close(2)

write(1,*)' nop'

do 999 i=1,ne

999 write(1,*)i,(nop(i,j),j=1,4)

write(1,*)' cord'

do 998 i=1,np

998 write(1,*)i,(cord(i,j),j=1,3)

ndf1=3

ncn=4

call NBND(nop,ne,nband,ndf1,ncn)

write(1,*)' nband=',nband

do 2 nj=1,ne

print *' element',nj

print *

call STI31(nj,em,pr,np0,ndf,cord,nop,ne,vvvv,estifm)

WRITE(8) ((ESTIFM(I2,J2),I2=1,12),J2=1,12)

2 continue

end file(1)

close(1)

close(8)

end file(12)

close(12)

stop

end