Zlati rez- iskanje maksimumov in minimumov

 

Naloga:
Napišite program, ki poišče maksimume in minimume funkcij.

program zlatirez
implicit none
real :: a,b,c,d,r,f
integer::i
write(*,*) 'vnesi levo krajisce intervala na katerem je maksimum ali minimum, a=?'
read(*,*)a
write(*,*) 'vnesi desno krajisce intervala na katerem je maksimum ali minimum, b=?'
read(*,*)b
write(*,*) 'napisi 1, ce zelis iskati maksimum ali karkoli drugega za minimum'
read(*,*)i
r=(sqrt(5.)-1)/2.
if (i==1) then
 do while (abs(a-b).gt.1e-5)  !1e-5 je natancnost na katero bomo dolocili maksimum
  c=a+(1-r)*(b-a)
  d=b-(1-r)*(b-a)
  write(*,'(4f10.6,2f10.2,f10.6)')a,b,c,d,f(c),f(d),abs(a-b)
  if (f(c).gt.f(d)) then
   b=d
  else
   a=c
  endif
 enddo
  write(*,'(4f10.6,2f10.2,f10.6)')a,b,c,d,f(c),f(d),abs(a-b)
  write(*,*)'maksimum je tocka =',c,f(c)
else
 do while (abs(a-b).gt.1e-5)  !1e-5 je natancnost na katero bomo dolocili minimum
  c=a+(1-r)*(b-a)
  d=b-(1-r)*(b-a)
  write(*,'(4f10.6,2f10.2,f10.6)')a,b,c,d,f(c),f(d),abs(a-b)
  if (f(c).lt.f(d)) then
   b=d
  else
   a=c
  endif
 enddo
  write(*,'(4f10.6,2f10.2,f10.6)')a,b,c,d,f(c),f(d),abs(a-b)
  write(*,*)'minimum je tocka =',c,f(c)
endif
end program zlatirez

function f(x)
implicit none
real::x,f
! tu napisemo funkcijo, katere niclo hocemo poiskati
f=0.2*x**5 - 4.02*x**4 - 2.009*x**3 - 4.099*x**2 - 19.0023*x + 50
end function f

Tekst sedaj shranimo kot datoteko zlatirez.f90 in prevedemo.

Tu je sedaj še print screen postopka prevajanja. V kolikor vam kakšna podrobnost ni jasna, mi sporočite.





Nazaj na osnovno stran za numerične metode za kemike.

 

Fakulteta za kemijo in kemijsko tehnologijo

Katedra za fizikalno kemijo

Univerza v Ljubljani

Večna pot 113, K3.009

1000 Ljubljana

Slovenija

tel: +386 1 479 8540

e-pošta: tomaz pika urbic at fkkt.uni-lj.si

Govorilne ure so po dogovoru.

Prešernove nagrade