[Fortran] 纯文本查看 复制代码
PROGRAM main
PARAMETER(PI=3.1415926)
REAL E1,E2,Js1,Js2,Os1,Os2,Ob1,Ob2,a1,a2,b1,b2,L,U,D,F
$ INTEGER ii,Nj,nR,nT
PARAMETER(E1=210000000000.0,E2=200000000000.0,E3=200000000000.0,
$ E4=120000000000.0,E5=12000000000.0,
$ Js1=61.4,Js2=60,Js3=1,Js4=1,Js5=1,
$ Jp1=80,Jp2=90,Jp3=1,Jp4=1,Jp5=1,
$ Os1=235000000,Os2=306000000,Os3=353000000,
$ Os4=1, Os5=1,
$ Ob1=372000,Ob2=471000,Ob3=1,Ob4=1,Ob5=1,
$ a1=304000000,
$ a2=460000000,a3=578000000,a4=332000000,a5=28700000,
$ b1=1120000,b2=2570000,b3=3744000,b4=1454000,b5=190000
$
$ )
PARAMETER (S1=5,S2=5)!S1行表示各个杆件，S2列分别表示输入出对象
CHARACTER *6 ORIGIN
!CHARACTER *1 N !杆件类型选择
!所需计算的杆件数量,也用来循环
PARAMETER (Nj=5,nR=5,nT=5,ii=5)
REAL SOLVE(S1,S2), O(Nj), Ocr(nR),J(nT),N1(ii)
$!计算结果数组和表示应力的数组
! S1为S2为列数
INTEGER U1
U1=3
ORIGIN='PRE.DAT'
OPEN(UNIT=U1,FILE=ORIGIN,STATUS='OLD',
$ ACCESS='SEQUENTIAL',FORM='FORMATTED')
READ(U1,100) N1(n),(SOLVE(n,J),J=1,S2) !杆件材料，边界，直径，长度，外力
DO 10 WHILE(N1(n).NE.' '.AND.n.LT.S2)
n=n+1
READ(U1,100)N1(n),(SOLVE(n,i),i=1,S2)
10 CONTINUE !在输入为空格或n大于给出数目时停止输入
n=n-1
DO 20 I=1,n
!N=SOLVE(I,1),L=SOLVE(I,2),D=SOLVE(I,3),
$ ! F=SOLVE(I,4),U=SOLVE(I,5)
$ !上为输入参数格式
J(I)=4*SOLVE(I,5)*SOLVE(I,2)/SOLVE(I,3) !拉姆达
O(I)=4*F/(PI*SOLVE(I,4)*SOLVE(I,4)) !应力
SELECTCASE (SOLVE(I,1))
CASE('1')
IF(J(I).GE.JS1) THEN
IF(J(I).GE.JP1) THEN
Ocr(I)=((PI*PI)*E1)/(J(I)*J(I))
ELSE
Ocr(I)=a1-b1*J(I)
ENDIF
ELSE
Ocr(I)=Os1
ENDIF
CASE('2')
IF(J(I).GE.JS2) THEN
IF(J(I).GE.JP2) THEN
Ocr(I)=((PI*PI)*E2)/(J(I)*J(I))
ELSE
Ocr(I)=a2-b2*J(I)
ENDIF
ELSE
Ocr(I)=Os2
ENDIF
CASE('3')
IF(J(I).GE.JS3) THEN
IF(J(I).GE.JP3) THEN
Ocr(I)=((PI*PI)*E3)/(J(I)*J(I))
ELSE
Ocr(I)=a3-b3*J(I)
ENDIF
ELSE
Ocr(I)=Os3
ENDIF
CASE('4')
IF(J(I).GE.JS4) THEN
IF(J(I).GE.JP4) THEN
Ocr(I)=((PI*PI)*E4)/(J(I)*J(I))
ELSE
Ocr(I)=a4-b4*J(I)
ENDIF
ELSE
Ocr(I)=Os4
ENDIF
CASE('5')
IF(J(I).GE.JS5) THEN
IF(J(I).GE.JP5) THEN
Ocr(I)=((PI*PI)*E5)/(J(I)*J(I))
ELSE
Ocr(I)=a5-b5*J(I)
ENDIF
ELSE
Ocr(I)=Os5
ENDIF
ENDSELECT
20 CONTINUE
OPEN(UNIT=2,FILE='AFT.DAT',STATUS='NEW',
$ ACCESS='SEQUENTIAL',FORM='FORMATTED')
WRITE(2,*)'计算结果如下所示：'
DO 40 I=1,n
IF(O(I).GE.Ocr(I)) THEN
WRITE(2,200) 'σ=',O(I),'σcr=',Ocr(I),'σ>= σcr,故压杆失稳'
ELSE
WRITE(2,200) 'σ=',O(I),'σcr=',Ocr(I),'σ<= σcr,故压杆稳定'
ENDIF
30 CONTINUE
40 CONTINUE
CLOSE(U1)
CLOSE(2)
WRITE(*,*)'计算完成，请自己查看输出结果文档。'
100 FORMAT(1x,I1,4F6.2)
200 FORMAT(1X,A,F6.2,A,F6.2,A)
END