TREŚĆ PROGRAMU
real Rp, Ra, Rb, Rc
real l,l1,l2,l3,l4,l5,l6,l7,l8,l9
real P, M, q1, q2, T, Mz
real x,dx
integer i,n,nrwar,kdan,kdan2
kdan=11
open (kdan, file="DANE.txt")
kdan2=22
open (kdan2, file="WYNIKI.txt")
1000 WRITE(*,*)'(1)-dane z klawiatury'
WRITE(*,*)'(2)-dane z pliku'
WRITE(*,*)'(3)-dane do pliku'
WRITE(*,*)'(4)-dane domyslne'
WRITE(*,*)'(5)-aktualne wartosci danych'
WRITE(*,*)'(6)-obliczenia + wyniki'
WRITE(*,*)'(99)-zakonczenie'
write(*,*)'wybierz przypadek'
read(*,*) nrwar
select case (nrwar)
case (99)
write(*,*)'PROGRAM ZAKONCZYL PRACE, NACISNIJ ENTER**'
pause
stop
case(1)
WRITE(*,*)'podaj wymiary dla kazdego l'
WRITE(*,*)'l1=? [m]'
READ(*,*) l1
WRITE(*,*)'l2=? [m]'
READ(*,*) l2
WRITE(*,*)'l3=? [m]'
READ(*,*) l3
WRITE(*,*)'l4=? [m]'
READ(*,*) l4
WRITE(*,*)'l5=? [m]'
READ(*,*) l5
WRITE(*,*)'l6=? [m]'
READ(*,*) l6
WRITE(*,*)'l7=? [m]'
READ(*,*) l7
WRITE(*,*)'l8=? [m]'
READ(*,*) l8
WRITE(*,*)'l9=? [m]'
READ(*,*) l9
WRITE(*,*)'podaj wartosc sily P'
READ(*,*) P
WRITE(*,*)'podaj wartosc momentu M'
READ(*,*) M
WRITE(*,*)'podaj wartosc sily q1'
READ(*,*) q1
WRITE(*,*)'podaj wartosc sily q2'
READ(*,*) q2
write(*,*)'podaj n'
read(*,*) n
go to 1000
case(2)
rewind (kdan)
read(kdan,*)l1,l2,l3,l4,l5,l6,l7,l8,l9,P,M,q1,q2,n
write(*,*)'l1=',l1
write(*,*)'l2=',l2
write(*,*)'l3=',l3
write(*,*)'l4=',l4
write(*,*)'l5=',l5
write(*,*)'l6=',l6
write(*,*)'l7=',l7
write(*,*)'l8=',l8
write(*,*)'l9=',l9
write(*,*)'P =',P
write(*,*)'M =',M
write(*,*)'q1=',q1
write(*,*)'q2=',q2
write(*,*)'n =',n
case(3)
rewind (kdan)
write(kdan,*)l1,l2,l3,l4,l5,l6,l7,l8,l9,P,M,q1,q2,n
case(4)
l1= 1
l2= 1
l3= 1
l4= 1
l5= 1
l6= 1
l7= 1
l8= 1
l9= 1
q1= 2
q2= 2
P= 2
M= 2
n=400
write(*,*)'l1=',l1
write(*,*)'l2=',l2
write(*,*)'l3=',l3
write(*,*)'l4=',l4
write(*,*)'l5=',l5
write(*,*)'l6=',l6
write(*,*)'l7=',l7
write(*,*)'l8=',l8
write(*,*)'l9=',l9
write(*,*)'P =',P
write(*,*)'M =',M
write(*,*)'q1=',q1
write(*,*)'q2=',q2
write(*,*)'n =',n
case(5)
write(*,*)'l1=',l1
write(*,*)'l2=',l2
write(*,*)'l3=',l3
write(*,*)'l4=',l4
write(*,*)'l5=',l5
write(*,*)'l6=',l6
write(*,*)'l7=',l7
write(*,*)'l8=',l8
write(*,*)'l9=',l9
write(*,*)'P =',P
write(*,*)'M =',M
write(*,*)'q1=',q1
write(*,*)'q2=',q2
write(*,*)'n=',n
case(6)
160 format (F6.2,2X,F8.3,2X,F8.3)
rewind (kdan2)
write(kdan2,'(I3)') n
call reakcje(l2,l3,l4,l5,l6,l7,l8,l9,
1 P,M,q1,q2,Rp,Ra,Rb,Rc)
write(*,*) 'Ra=',Ra
write(*,*) 'Rb=',Rb
write(*,*) 'Rc=',Rc
write(*,*) 'Rp=',Rp
l=l1+l2+l3+l4+l5+l6+l7+l8+l9
dx=l/n
write(*,*) 'dx=',dx
x=0
write(*,*) ' x[m] T[kN] Mz[kN/m]'
do i=1,n+1
call oblicz(x,l1,l2,l3,l4,l5,l6,l7,l8,l9,P,M,
1 q1,q2,Ra,Rb,Rc,T,Mz)
write(*,160) x,T,Mz
write(kdan2,160) x,T,Mz
x=x+dx
end do
case default
write(*,*)'nieistiniejacy wariant,nrwar=',nrwar
pause
end select
go to 1000
end
SUBROUTINE REAKCJE(l2,l3,l4,l5,l6,l7,l8,l9,P,M,
1 q1,q2,Rp,Ra,Rb,Rc)
REAL l2,l3,l4,l5,l6,l7,l8,l9
REAL P,M,q1,q2,Rp,Ra,Rb,Rc
Rp=(q2*l8*(l8/2+l9))/(l7+l8+l9)
Rb=(M+q1*l3*(l3/2+l2)+P*(l5+l4+l3+l2)+
1 Rp*(l6+l5+l4+l3+l2))/(l4+l3+l2)
Ra=(-M+q1*l3*(l3/2+l4+l5+l6)-Rb*(l5+l6)+P*l6)/(l2+l3+l4+l5+l6)
Rc=-(-q2*l8*(l8/2+l7))/(l7+l8+l9)
RETURN
END
SUBROUTINE OBLICZ(x,l1,l2,l3,l4,l5,l6,l7,l8,l9,P,M,
1 q1,q2,Ra,Rb,Rc,T,Mz)
REAL l1,l2,l3,l4,l5,l6,l7,l8,l9
REAL P,M,q1,q2,Ra,Rb,Rc,T,Mz,x
INTEGER kdan2
kdan2=22
IF(x.ge.0.and.x.lt.l1) THEN
T=0
Mz=M
ELSE IF(x.ge.l1.and.x.lt.l1+l2) THEN
T=Ra
Mz=M+(Ra*(x-l1))
ELSE IF(x.ge.l1+l2.and.x.lt.l1+l2+l3) THEN
T=Ra-(q1*(x-l1-l2))
Mz=M+Ra*(x-l1)-(q1*(x-l1-l2)*((x-l1-l2)/2))
ELSE IF(x.ge.l1+l2+l3.and.x.lt.l1+l2+l3+l4) THEN
T=Ra-(q1*l3)
Mz=M+Ra*(x-l1)-(q1*l3*(x-(l3/2)-l2-l1))
ELSE IF(x.ge.l1+l2+l3+l4.and.x.lt.l1+l2+l3+l4+l5) THEN
T=Ra-(q1*l3)+Rb
Mz=M+Ra*(x-l1)-(q1*l3*(x-l3/2-l1-l2))+(Rb*(x-l1-l2-l3-l4))
ELSE IF(x.ge.l1+l2+l3+l4+l5.and.x.lt.l1+l2+l3+l4+l5+l6) THEN
T=Ra-(q1*l3)+Rb-P
Mz=M+(Ra*(x-l1))-(q1*l3*(x-l3/2-l2-l1))+
1 (Rb*(x-l4-l3-l2-l1))-(P*(x-l5-l4-l3-l2-l1))
ELSE IF(x.ge.l1+l2+l3+l4+l5+l6.and.x.lt.l1+l2+l3+l4
1 +l5+l6+l7) THEN
T=Ra-(q1*l3)+Rb-P
Mz=M+(Ra*(x-l1))-(q1*l3*(x-l3/2-l2-l1))+
1 (Rb*(x-l4-l3-l2-l1))-(P*(x-l5-l4-l3-l2-l1))
ELSE IF(x.ge.l1+l2+l3+l4+l5+l6+l7.and.x.lt.l1+l2+l3+
1 l4+l5+l6+l7+l8) THEN
T=Ra-(q1*l3)+Rb-P-(q2*(x-l1-l2-l3-l4-l5-l6-l7))
Mz=M+(Ra*(x-l1))-(q1*l3*(x-l3/2-l2-l1))+(Rb*(x-l4-l3-l2-l1))-
1 (P*(x-l5-l4-l3-l2-l1))-(q2*(x-l7-l6-l5-l4-l3-l2-l1)*((x-l7-l6-l5-
1 l4-l3-l2-l1)/2))
ELSE IF(x.ge.l1+l2+l3+l4+l5+l6+l7+l8.and.x.lt.l1+l2+l3+
1 l4+l5+l6+l7+l8+l9) THEN
T=Ra-(q1*l3)+Rb-P-(q2*l8)
Mz=M+(Ra*(x-l1))-(q1*l3*(x-l3/2-l2-l1))+(Rb*(x-l4-l3-l2-l1))
1 -(P*(x-l5-l4-l3-l2-l1))-(q2*l8*(x-l8/2-l7-l6-l5-l4-l3-l2-l1))
ELSE IF(x.ge.l1+l2+l3+l4+l5+l6+l7+l8+l9.or.x.eq.
1 l1+l2+l3+l4+l5+l6+l7+l8+l9) THEN
T=Ra-q1*l3+Rb-P-q2*l8+Rc
Mz=M+Ra*(l2+l3+l4+l5+l6+l7+l8+l9)-q1*l3*(l3/2+l4+l5+l6+l7+
1 l8+l9)+Rb*(l5+l6+l7+l8+l9)-P*(l6+l7+l8+l9)-q2*l8*(l8/2+l9)
END IF
RETURN
END
GRAFIKA :
TREŚĆ PROGRAMU:
$nolist
include'fgraph.fi'
include'fgraph.fd'
$list
real tmin,tmax,mmin,mmax,T,Mz,deltat,deltam
real skalat,skalam,skalax,xp
integer d,i,n
record /xycoord/xy
d=setvideomode($maxresmode)
d=registerfonts('c:\f5e\*.fon')
d=setfont("t'helv'h12w8b")
c szukanie extremow
tmin=0
tmax=0
mmin=0
mmax=0
open (unit=8, file='wyniki.txt')
read (8,'(I3)') n
do i=0, n
read (8,"(8X,F8.3,2X,F8.3)") T,Mz
tmin=min(tmin,T)
tmax=max(tmax,T)
mmin=min(mmin,Mz)
mmax=max(mmax,Mz)
end do
rewind(8)
c okreslenie skali
deltat=max(abs(tmin),abs(tmax))
deltam=max(abs(mmin),abs(mmax))
if (deltat.gt.0) then
skalat=100/deltat
endif
if (deltam.gt.0) then
skalam=100/deltam
endif
skalax=400/n
c ramki itp
call clearscreen(0)
write (*,'(3(/),56X,A18)') "Wykres sil tnacych"
write (*,'(3(/),56X,A5,F8.3,1X,A5)') "Tmax=",tmax,"[kN]"
write (*,'(1(/),56X,A5,F8.3,1X,A5)') "Tmin=",tmin,"[kN]"
write (*,'(8(/),44X,A27)') "Wykres momentow"
write (*,'(40X,A27)') "zginajacych"
write (*,'(3(/),56X,A5,F8.3,1X,A5)') "Mmin=",mmin,"[kNm]"
write (*,'(1(/),56X,A5,F8.3,1X,A5)') "Mmax=",mmax,"[kNm]"
d=setcolor(1)
d=rectangle($GBORDER,5,5,415,225)
d=rectangle($GBORDER,5,255,415,475)
call moveto(0,240,xy)
d=lineto(639,240)
d=setcolor(2)
call moveto(10,115,xy)
d=lineto(410,115)
call moveto(10,365,xy)
d=lineto(410,365)
c wykresy
d=setcolor(15)
call moveto(10,115,xy)
read (8,"(I3)") n
do i=0, n
read (8,"(8X,F8.3)") T
xp=10+i*skalax
d=lineto(xp,115-skalat*T)
enddo
d=lineto(410,115)
rewind(8)
call moveto(10,365,xy)
read (8,"(I3)") n
do i=0, n
read (8,"(18X,F8.3)") Mz
xp=10+i*skalax
d=lineto(xp,365+skalam*Mz)
enddo
d=lineto(410,365)
close(8)
read (*,*)
end
PRZYKŁAD:
Wprowadzone dane:
50
.00 .000 5.000
.18 .000 5.000
.36 .000 5.000
.54 .000 5.000
.72 .000 5.000
.90 .000 5.000
1.08 -2.500 4.800
1.26 -2.500 4.350
1.44 -2.500 3.900
1.62 -2.500 3.450
1.80 -2.500 3.000
1.98 -2.500 2.550
2.16 -3.300 2.036
2.34 -4.200 1.361
2.52 -5.100 .524
2.70 -6.000 -.475
2.88 -6.900 -1.636
3.06 -7.500 -2.950
3.24 -7.500 -4.300
3.42 -7.500 -5.650
3.60 -7.500 -7.000
3.78 -7.500 -8.350
3.96 -7.500 -9.700
4.14 7.500 -8.950
4.32 7.500 -7.600
4.50 7.500 -6.250
4.68 7.500 -4.900
4.86 7.500 -3.550
5.04 2.500 -2.400
5.22 2.500 -1.950
5.40 2.500 -1.500
5.58 2.500 -1.050
5.76 2.500 -.600
5.94 2.500 -.150
6.12 2.500 .300
6.30 2.500 .750
6.48 2.500 1.200
6.66 2.500 1.650
6.84 2.500 2.100
7.02 2.400 2.549
7.20 1.500 2.900
7.38 .600 3.089
7.56 -.300 3.116
7.74 -1.200 2.981
7.92 -2.100 2.684
8.10 -2.500 2.250
8.28 -2.500 1.800
8.46 -2.500 1.350
8.64 -2.500 .900
8.82 -2.500 .450
9.00 -2.500 .000
WYNIK: