用fortran设计

这是一个顺序结构编程，就按你的计算过程编就可派薯以

program lx

write(*,*) '梁有效支承长度：尘瞎者'

write(*,*) 'a0＝205.7mm＜a＝240mm'

write(*,*) '梁端局部受压面积：Al＝a0b＝205.7×200＝41140mm2'

write(*,*) '局部抗压强度计算面积：A0＝（b+2h）h＝（200+2×240）×240＝163200mm2'

write(*,*) '＝3.97＞3，不考虑上部荷载的影响，取ψ=0'

write(*,*) '砌体局部抗压强度提高系数：'

write(*,*) 'γ＝1＋0.35＝1＋神握0.35＝1.603＜2.0'

write(*,*) '则ηγfAl＝0.7×1.603×1.3×41140＝60012.2N＝60.01kN＞Nl＝60kN'

write(*,*) '局部受压满足要求。'

end

给余梁一个平面桁架计算程序：轿此

integer*2 li(100000)

real*4 a(1000000)

logical*4 results

CHARACTER*20 NAM1,NAM2

! WRITE(*,'(A\)') ' PLEASE INPUT YOUR DATE-FILE NAME------>'

! READ(*,'(A)') NAM1

! READ(*,*)

! OPEN(1,FILE=NAM1,STATUS='OLD')

! WRITE(*,'(/,A\)') ' PLEASE INPUT YOUR OUT-FILE NAME------>'

! READ(*,'(A)') NAM2

! OPEN(2,FILE=NAM2,STATUS='unknown')

open(1,file='trus3.in',STATUS='unknown')

open(2,file='trus3.out',STATUS='unknown')

open(3,file='trus3.mout',STATUS='unknown')

read(1,*) nn,ne,nc,np

! nn:节点总数ne:单元总数nc:支撑约束数；np:荷载总数

write(2,'(a)') 'INITIAL PARAMETER'

write(2,'竖帆运(4x,4A6/4x,4I6)') 'nn','ne','nc','np',nn,ne,nc,np

n3=nn*3 !总自由度

n=n3-nc

iu=1

iaa=iu+n3

iea=iaa+ne

ix=iea+ne

iy=ix+nn

iz=iy+nn

isq=iz+nn

ish=isq+3

idc=ish+3

ist=idc+3

mal=ist+36

jia=1

jja=jia+ne

jns=jja+ne

nal=jns+2*nc

na=10000-mal

nli=1000-nal

call trus3(a(iu),a(iaa),a(iea),a(ix),

& a(iy),a(iz),a(isq),a(ish),a(idc),

& a(ist),a(mal),li(nal),li(jia),li(jja),

& li(jns),nn,ne,nc,np,n3,n,na,nli)

close(1)

close(2)

close(3)

results= SYSTEMQQ('d:\\TEDIT.EXE

&e:\\WORKfor90\\SPT1_OK\\trus3.out ')

results= SYSTEMQQ('d:\\TEDIT.EXE

&e:\\WORKfor90\\SPT1_OK\\trus3.mout ')

stop

end

!**********************************************************************************

subroutine trus3(u,aa,ea,x,y,z,sq,sh,

& dc,sk,a,li,ia,ja,ns,nn,ne,nc,np,

&n3,n,na,nli)

integer*2 ia(ne),ja(ne),ns(nc,2),li(nli),jod(np,2)

real*4 u(n3),aa(ne),ea(ne),x(nn),y(nn),z(nn),

& sq(3),sh(3),dc(3),sk(6,6),a(na),qd(np)

!读节点坐标、支座约束、左右节点号、截面面积、d性模量信息

read(1,*) (x(i),y(i),z(i),i=1,nn),

& (ns(i,1),ns(i,2),i=1,nc),

& (ia(i),ja(i),aa(i),ea(i),i=1,ne)

write(2,'(1x,a)') 'NODAL COORDINATES'

write(2,'(4x,a4,3a12)') 'NO.','X-COOR','Y-COOR','Z-COOR'

write(2,'(4x,i4,3f12.3)') (i,x(i),y(i),z(i),i=1,nn)

write(2,'(/1x,a)') 'POINTS OF SUPPRESSED DISPLACEMENTS'

write(2,'(2a10/(2i10))') 'NO.','DIRECTION',

&(ns(i,1),ns(i,2),i=1,nc)

write(2,'(/1x,a)') 'MEMBER DETAILS'

write(2,'(4x,a4,a6,a3,2a12/

& (3x,''('',i3,'')'',i6,''-'',i2,

& 2e12.3))') 'NE.','I','-J','A','E',

& (i,ia(I),ja(i),aa(i),ea(i),i=1,ne)

!读入荷载数据：

!jod(i,1)受荷节点号；jod(i,2)荷载作用方向(1表示x向2表示x向3表示x向)qd(i)荷载大小,

write(2,'(/1x,a)') ' EXTERNAL LOADS'

do 999 i=1,np

jod(i,1)=0

jod(i,2)=0

qd(i)=0.0

999 continue

read(1,*) (jod(i,1), jod(i,2),qd(i),i=1,np)

write(2,'(a10,3x,a10,a13/(2i10,f16.3))')

& ' NO.','DIRECTION','VALUE',

&(jod(i,1),jod(i,2),qd(i),i=1,np)

!求最大带宽

mx=0

do 400 i=1,ne

io=iabs(ja(i)-ia(i)) !左右最大节点号差

if(io.gt.mx) mx=io

400 continue

nb=(mx+1)*3

nt=n3+nb

iia=1

iq=iia+nt*nb

ic=iq+nt

iqd=ic+nt

mal=iqd+np+na

jjod=1

nal=jjod+2*np+nli

call s410(u,aa,ea,x,y,z,sq,sh,

& dc,sk,a,q,c,qd,jod,ia,ja,ns,nn,ne,

& nc,np,n3,n,nb,nt)

return

end

*****************************************************************************

subroutine s410(u,aa,ea,x,y,z,sq,sh,

& dc,sk,a,q,c,qd,jod,ia,ja,ns,nn,ne,

& nc,np,n3,n,nb,nt)

integer*2 ia(ne),ja(ne),ns(nc,2),jod(np,2)

real*4 u(n3),aa(ne),ea(ne),x(nn),y(nn),

& z(nn),sq(3),sh(3),dc(3),sk(6,6),

& a(nt,nb),q(nt),c(nt),qd(np),l

********************************************************************

* 检查传入数据*

********************************************************************

! write(*,'(a)') 'INITIAL PARAMETER'

! write(*,'(4x,4A6/4x,4I6)') 'nn','ne','nc','np',nn,ne,nc,np

! write(*,'(1x,a)') 'NODAL COORDINATES'

! write(*,'(4x,a4,3a12)') 'NO.','X-COOR','Y-COOR','Z-COOR'

! write(*,'(4x,i4,3f12.3)') (i,x(i),y(i),z(i),i=1,nn)

! write(*,'(/1x,a)') 'POINTS OF SUPPRESSED DISPLACEMENTS'

! write(*,'(2a10/(2i10))') 'NO.','DIRECTION',

! &(ns(i,1),ns(i,2),i=1,nc)

! write(*,'(/1x,a)') 'MEMBER DETAILS'

! write(*,'(4x,a4,a6,a3,2a12/

! & (3x,''('',i3,'')'',i6,''-'',i2,

! & 2f12.3))') 'NE.','I','-J','A','E',

! &(i,ia(I),ja(i),aa(i),ea(i),i=1,ne)

!write(*,'(a10,3x,a10,a13/(2i10,f16.3))')

! & ' NO.','DIRECTION','VALUE',

! &(jod(i,1),jod(i,2),qd(i),i=1,np)

!

********************************************************************

! pause 1

!总刚矩阵及荷载列阵清零

do 480 i=1,nt

do 450 j=1,nb

a(i,j)=0.0

450continue

q(i)=0.0

480 continue

!形成荷载向量

do 544 i=1,np

npd=jod(i,1)*3+jod(i,2)-3 !相应荷载位置=节点号*3+节点方向数(1 2 3)-3

q(npd)=q(npd)+qd(i)

544 continue

!对单元循环形成单元刚度矩阵并加入总刚矩阵

do 1120 me=1,ne

write(3,*) me

i=ia(me) !单元左端号

j=ja(me) !单元右端号

ao=aa(me)!单元面积

e=ea(me) !单元d性模量

!求单元方向余弦

l=sqrt((x(j)-x(i))**2+(y(j)-y(i))**2+(z(j)-z(i))**2)

xc=(x(j)-x(i))/l

yc=(y(j)-y(i))/l

zc=(z(j)-z(i))/l

!求单刚元素

sk(1,1)=xc**2

sk(1,2)=xc*yc

sk(2,1)=sk(1,2)

sk(2,2)=yc**2

sk(1,3)=xc*zc

sk(3,1)=sk(1,3)

sk(3,2)=yc*zc

sk(2,3)=sk(3,2)

sk(3,3)=zc**2

sk(4,1)=-xc**2

sk(4,2)=-xc*yc

sk(4,3)=-xc*zc

sk(5,1)=-xc*yc

sk(5,2)=-yc**2

sk(5,3)=-yc*zc

sk(6,1)=-xc*zc

sk(6,2)=-yc*zc

sk(6,3)=-zc**2

do 870 ii=1,3

do 870 jj=1,3

sk(ii+3,jj+3)=sk(ii,jj)

sk(ii,jj+3)=sk(jj+3,ii)

870 continue

cn=ao*e/l

do 930 ii=1,6

do 930 jj=1,6

sk(ii,jj)=sk(ii,jj)*cn

! write(3,*) sk(ii,jj) !!!!!!

930 continue

!将单刚矩阵送入总刚矩阵

i1=3*i-3

j1=3*j-3

! pause 4 !检测断点

do 1114 jj=1,2

if(jj.eq.1) nr=i1

if(jj.eq.2) nr=j1

do 1112 j9=1,3

nr=nr+1

ii=(jj-1)*3+j9

do 1110 kk=1,2

if(kk.eq.1) n9=i1

if(kk.eq.2) n9=j1

do 1100 k=1,3

ll=(kk-1)*3+k

nk=n9+k+1-nr

if(nk.le.0) goto 1100

a(nr,nk)=a(nr,nk)+sk(ii,ll)

1100 continue

1110continue

1112 continue

* pause 4 !检测断点

1114 continue

1120 continue

!引入支座约束条件

do 1150 i=1,nc

npd=ns(i,1)*3+ns(i,2)-3

a(npd,1)=a(npd,1)*(1e+12)+(1e+12)!

q(npd)=0

1150 continue

!荷载列阵交给方程右端项

n=n3

do 1190 ii=1,n3

c(ii)=q(ii)

write(3,*) c(ii) !!!!!!!!!!!!!!!!!

1190 continue

!调用解方程子程序

call s2000(a,c,n,nb,nt)

!求得位移项交给位移列阵

1220 do 1230 ii=1,n3

1230 u(ii)=c(ii)

!输出位移结果

write(2,'(/1x,a)') 'NODAL DISPLACEMENTS'

write(2,'(a8,a10,2a12/(i8,3f12.5))') 'no.','u','v','w',

&(ii,u(3*ii-2),u(3*ii-1),u(3*ii),ii=1,nn)

!输出内力结果

write(2,'(/1x,a)') 'FORCE IN THE MEMBERS'

write(2,'(4x,a4,a6,a3,a16)') 'ne','i','-j','force'

do 1610 me=1,ne

i=ia(me)

j=ja(me)

ao=aa(me)

e=ea(me)

l=sqrt((x(j)-x(i))**2+(y(j)-y(i))**2+(z(j)-z(i))**2)

xc=(x(j)-x(i))/l

yc=(y(j)-y(i))/l

zc=(z(j)-z(i))/l

dc(1)=xc

dc(2)=yc

dc(3)=zc

i1=3*i-3

j1=3*j-3

do 1510 i3=1,3

j3=i1+i3

j2=j1+i3

sq(i3)=u(j3)

sh(i3)=u(j2)

1510 continue

a1=0.0

a2=0.0

do 1570 ii=1,3

a1=a1+dc(ii)*sq(ii)

a2=a2+dc(ii)*sh(ii)

1570 continue

!内力=面积*d性模量*应变（两端位移差与总长比值）

fc=ao*e*(a2-a1)/l

write(2,'(4x,''('',i2,'')'',i6,''-'',i2,f16.5)')

& me,ia(me),ja(me),fc

1610 continue

return

end

subroutine s2000(a,cc,n,nb,nt)!半带宽解线性方程组子程序

real*4 a(nt,nb),cc(nt)

2000 do 2940 ii=1,n

ik=ii

do 2920 jj=2,nb

ik=ik+1

cn=a(ii,jj)/a(ii,1)

jk=0

do 2890 kk=jj,nb

jk=jk+1

2890 a(ik,jk)=a(ik,jk)-cn*a(ii,kk)

a(ii,jj)=cn

2920 cc(ik)=cc(ik)-cn*cc(ii)

2940 cc(ii)=cc(ii)/a(ii,1)

do 3010 iz=2,n

ii=n-iz+1

do 3000 kk=2,nb

jj=ii+kk-1

3000 cc(ii)=cc(ii)-a(ii,kk)*cc(jj)

3010 continue

return

end

trus3.in

6,9,9,2

0, 0, 4.0,

0, 0,-4.0,

0,10.0, 0,

12.0,0, 4.0,

12.0,0,-4.0,

12.0,-7.0,0,

1,1,1,2,1,3,

2,1,2,2,2,3,

3,1,3,2,3,3,

5,3,3.0e-4,1.2e+12,

4,3,3.0e-4,1.2e+12,

4,1,3.0e-4,1.2e+12,

4,5,3.0e-4,1.2e+12,

5,2,3.0e-4,1.2e+12,

6,1,3.0e-4,1.2e+12,

4,6,3.0e-4,1.2e+12,

5,6,3.0e-4,1.2e+12,

6,2,3.0e-4,1.2e+12,

6,1, 2500.0,

6,2,-4330.1,

Fortran源自于“公式翻译”（英语：FormulaTranslation）的缩写，是一种编程语言。

它是世界上芦肢世最早出现的计算机高级程序设计语言，广泛应用于科学和工程计算领域。FORTRAN语言以其特有的功能在数值、科学和工程计算领域发挥着重要作用。

随着FORTRAN语言版本的不断更新和变化，饥旅语言不兼容性问题日益突出，语言标准化工作被提上了日程。

1962年5月：美国标准化协会(简称ANSI)着手进行FORTRAN语言标准化的研究工作。

1966年：ANSI正式公布了两个标准文本：美国国家标准FORTRAN(ANSI X3.9-1966)和美国国家标准基本FORTRAN(ANSI X3.10-1966)，前者相当于FORTRAN Ⅳ，后者相当于FORTRANⅡ。基本FORTRAN是美国国家标准FORTRAN的一个子集，从而实现了语言的向下兼容，初步解决了语言的兼陪肢容性问题。

---