Fortran

teo

Πολύ δραστήριο μέλος

Ο Θοδωρής αυτή τη στιγμή δεν είναι συνδεδεμένος. Είναι 37 ετών και επαγγέλεται Φοιτητής/τρια. Έχει γράψει 1,573 μηνύματα.

FORTRAN
Η γλώσσα FORTRAN (από τα αρχικά FORmulae TRANslator - μεταφραστής τύπων) είναι μία από τις πρώτες γλώσσες υψηλού επιπέδου, η οποία χρησιμοποιήθηκε κυρίως σε επιστημονικές αλλά και σε εμπορικές εφαρμογές. Δημιουργήθηκε τη δεκαετία του 1950 από την ΙΒΜ και χρησιμοποιείται μέχρι και σήμερα. Αρχικά η FORTRAN ήταν προσανατολισμένη στην επίλυση μαθηματικών προβλημάτων.​
ΑΣΚΗΣΕΙΣ ΣΤΗΝ FORTRAN
Askisi_1! πρόγραμμα υπολογισμού ενός αριθμού σε μία δύναμη-ver1

program power1
implicit none
integer::a,n,i,c
write(*,*)'Dose thn bash kai tom ektheth:'
read(*,*)a,n
c=1
do i=1,n,1
c=c*a
end do
write(*,*)'Apotelesma:',c
stop
end program power1

Askisi_2 ! Πρόγραμμα υπολογισμού ενός αριθμού σε μία δύναμη με χρήση συνάρτησης-ver2

program power2
implicit none
integer::b,e,power
write(*,*)'Dose thn bash kai ton ektheth:'
read(*,*)b,e
write(*,*)'Apotelesma:',power(b,e)
stop
end program power2

integer function power(a,n)
integer::apot,i,n,a
apot=1
do i=1,n,1
apot=apot*a
end do
power=apot
end function power

Askisi_3 ! Πρόγραμμα υπολογισμού ενός αριθμού σε μία δύναμη με χρήση συνάρτησης ver-3

program power3
implicit none
integer::b,e
real::power
write(*,*)'Dose thn bash kai ton ektheth:'
read(*,*)b,e
write(*,*)'Apotelesma:',power(b,e)
stop
end program power3

real function power(a,n)
integer::i,n,a
real::c
c=1.000000
if (n>0) then
do i=1,n,1
c=c*a
end do
else
do i=1,-n,1
c=c*a
end do
c=1/c
end if
power=c
end function power

Askisi_4 ! Max και min σε μονοδιάστατο πίνακα

program max_min_thesi
integer::i,n,max,min,thesi_max,thesi_min,x(100)
write(*,*)'Dose to megethos tou pinaka X:'
read(*,*)n
do i=1,n,1
write(*,*)'Dose to stoixeio:',i
read(*,*)x(i)
end do
max=x(1)
min=x(1)
thesi_max=1
thesi_min=1
do i=2,n,1
if (x(i)>max) then
max=x(i)
thesi_max=i
else if (x(i)<min) then
min=x(i)
thesi_min=i
end if
end do
write(*,*)'MAX=',max
write(*,*)'THESI_MAX=',thesi_max
write(*,*)'MIN=',min
write(*,*)'THESI_MIN=',thesi_min
stop
end program max_min_thesi

Askisi_5 ! Συχνότητα αριθμού σε μονοδιάστατο πίνακα

program syxnotita
integer::i,n,s,pro_num,x(100)
write(*,*)'Dose to megethos tou pinaka X:'
read(*,*)n
do i=1,n,1
write(*,*)'Dose to stoixeio:',i
read(*,*)x(i)
end do
s=0
i=1
pro_num=x(i)
do while (i<=n)
if (pro_num<>x(i)) then
write(*,*)'Arithmos=',pro_num
write(*,*)'Syxnotita=',s
s=0
pro_num=x(i)
end if
i=i+1
s=s+1
end do
write(*,*)'Arithmos=',pro_num
write(*,*)'Syxnotita=',s
stop
end program syxnotita

Askisi_6 ! Bubble sort

program bubble_sort
integer::i,n,a(100),temp,j
write(*,*)'Dose to megethos tou pinaka A:'
read(*,*)n
do i=1,n,1
write(*,*)'Dose to stoixeio:',i
read(*,*)a(i)
end do
do i=1,n-1,1
do j=1,n-1,1
if (a(j+1)<a(j)) then
temp=a(j+1)
a(j+1)=a(j)
a(j)=temp
end if
end do
end do
do j=1,n,1
write(*,*)a(j)
end do
stop
end program bubble_sort

Askisi_7 ! Ο υπολογισμός του παραγοντικού χωρίς αναδρομική συνάρτηση

program parag1
implicit none
integer::num,i,parag
write(*,*)'Dose enan arithmo:'
read(*,*)num
parag=1
do i=2,num,1
parag=parag*i
end do
write(*,*),num,parag
stop
end program parag1

Askisi_8 ! Χρήση μιας αναδρομικής συνάρτησης-Υπολογισμός του παραγοντικού

program parag
integer::num,par
write(*,*)'Dose enan arithmo:'
read(*,*)num
write(*,*)num,par(num)
stop
end program parag

recursive function par(n) result(apot)
integer::n,apot
if (n==0) then
apot=1
else
apot=par(n-1)*n
end if
end function par

Askisi_9 ! Χρήση μιας αναδρομικής συνάρτησηs-Υπολογισμός n-οστού όρου Fibonacci

program fibonacci
integer::i,n,fib
write(*,*)'Dose timi sto n:'
read(*,*)n
do i=0,n-1,1
write(*,*)fib(i)
end do
stop
end program fibonacci

recursive function fib(n) result(oros)
integer::n,oros
if (n<=1) then
oros=n
else
oros=fib(n-1)+fib(n-2)
end if
end function fib

Askisi_10 ! Οι βασικές πράξεις(+,-,*,/) υλοποιούνται με συναρτήσεις

program pr
integer::num1,num2,pros,afer,pol,dier,choise
write(*,*)'1.+'
write(*,*)'2.-'
write(*,*)'3.*'
write(*,*)'4./'
write(*,*)'Give a choise:'
read(*,*)choise
write(*,*)'Dose dyo arithmous:'
read(*,*)num1,num2
select case (choise)
case (1)
write(*,*)pros(num1,num2)
case (2)
write(*,*)afer(num1,num2)
case (3)
write(*,*)pol(num1,num2)
case (4)
if (num2<>0) then
write(*,*)dier(num1,num2)
else
write(*,*)'error'
end if
case default
write(*,*)'wrong choise'
end select
stop
end program pr

integer function pros(a,b)
integer::a,b,apot
apot=a+b
pros=apot
end function pros

integer function afer(a,b)
integer::a,b,apot
apot=a-b
afer=apot
end function afer

integer function pol(a,b)
integer::a,b,apot
apot=a*b
pol=apot
end function pol

integer function dier(a,b)
integer::a,b,apot
apot=a/b
dier=apot
end function dier

Askisi_11 ! συνάρτηση υπολογισμού αθροισμάτων

program s
integer::sum1,n
write(*,*)'Dose timi sto n:'
read(*,*)n
write(*,*)'sum=',sum1(n)
stop
end program s

integer function sum1(n)
integer::n,i,sum
sum=0
do i=1,n,1
sum=sum+i
end do
sum1=sum
end function sum1

Askisi_12 ! ΜΚΔ(α,β) με χρήση συνάρτησης

program test
integer::mkd,n1,n2
write(*,*)'Dose dyo arithmous:'
read(*,*)n1,n2
write(*,*)mkd(n1,n2)
stop
end program test

integer function mkd(a,b)
integer::a,b,i
do while (b<>0)
i=MOD(a,b)
a=b
b=i
end do
mkd=a
end function mkd

Askisi_13 !Merge Array Δυο πινάκων σε έναν τρίτο πίνακα

program merge
implicit none
integer::a(100),b(100),c(200),i,j,k,l,temp,n,m
write(*,*)'Dose to megethos tou pinaka A:'
read(*,*)n
do i=1,n,1
write(*,*)'Dose to stoixeio:',i
read(*,*)a(i)
end do
do i=1,n-1,1
do j=1,n-1,1
if (a(j+1)<a(j)) then
temp=a(j+1)
a(j+1)=a(j)
a(j)=temp
end if
end do
end do
write(*,*)'Dose to megethos tou pinaka B:'
read(*,*)m
do j=1,m,1
write(*,*)'Dose to stoixeio:',j
read(*,*)b(j)
end do
do i=1,m-1,1
do j=1,m-1,1
if (b(j+1)<b(j)) then
temp=b(j+1)
b(j+1)=b(j)
b(j)=temp
end if
end do
end do
i=1
j=1
k=1
do while ((i<=n) .AND. (j<=m))
if (a(i)<b(j)) then
c(k)=a(i)
k=k+1
i=i+1
else
c(k)=b(j)
k=k+1
j=j+1
end if
end do
if (i>n) then
do l=k,n+m,1
c(l)=b(j)
j=j+1
end do
else
do l=k,n+m,1
c(l)=a(i)
i=i+1
end do
end if
do l=1,n+m,1
write(*,*)c(l)
end do
stop
end program merge

Askisi_14 ! Υπολογισμός Αριθμού συνδυασμών (n k)=n!/k!(n-k)!

program test
integer::n,k,parag,i,combination,a,b
write(*,*)'Dose to n kai to k:'
read(*,*)n,k
a=1
do i=n,n-k+1,-1
a=a*i
end do
b=parag(k)
combination=a/b
write(*,*)'combination=',combination
stop
end program test

recursive function parag(n) result(apot)
integer::n,apot
if (n==0) then
apot=1
else
apot=parag(n-1)*n
end if
end function parag

Askisi_15 !Χρήση της iostat=v οπου v integer αριθμός


program a2
integer::i,n,a(100),v
write(*,*)'Dose timh sthn N:'
read(*,*)n
i=1
do
write(*,*)'Dose to stoixeio:',i
read(*,*,iostat=v)a(i)
i=i+1
if (i>n)exit
end do
i=1
do
write(*,*)a(i)
i=i+1
if (i>n)exit
end do
stop
end program a2

Askisi_16 !Η ολική αντίσταση τριών αντιστάσεων r1,r2 και r3, που είναι συνδεδεμένες παράλληλα δίνεται από τον τύπο:
1/R=1/r1+1/r2+1/r3
Η ολική αντίσταση τριών αντιστάσεων r1,r2 και r3, που είναι συνδεδεμένες σε σειρά δίνεται από τον τύπο:
R=r1+r2+r3
Γράψτε ένα πρόγραμμα, που να υπολογίζει την ολική αντίσταση R, όταν δίνονται οι αντιστάσεις r1,r2 και r3-ver1.
Λύση:

program lesson1
real::f1,f2,r1,r2,r3
write(*,*)'Dose ths antistaseis r1,r2 kai r3:'
read(*,*)r1,r2,r3
write(*,*)f1(r1,r2,r3)
write(*,*)f2(r1,r2,r3)
stop
end program lesson1

real function f1(r1,r2,r3)
real::r,r1,r2,r3
r=1/r1+1/r2+1/r3
r=1/r
f1=r
end function f1

real function f2(r1,r2,r3)
real::r,r1,r2,r3
r=r1+r2+r3
f2=r
end function f2

Askisi_17 ! ver2

program lesson1
real::f1,f2,n
write(*,*)'Dose to n:'
read(*,*)n
write(*,*)f1(n)
write(*,*)f2(n)
pause 'Pata ENTER gia na synexiseis!'
stop
end program lesson1

real function f1(n)
real::r,n,i
do i=1,n,1
r=r+1/i
end do
r=1/r
f1=r
end function f1

real function f2(n)
real::r,n,i
do i=1,n,1
r=r+i
end do
f2=r
end function f2

Askisi_18 !ver3

program lesson1
real::f1,f2,n
write(*,*)'Dose to n:'
read(*,*)n
write(*,*)f1(n)
write(*,*)f2(n)
pause 'Pata ENTER gia na synexiseis!'
stop
end program lesson1

real function f1(n)
real::r,n,i,a(100)
do i=1,n,1
write(*,*)'Dose to r:',i
read(*,*)a(i)
r=r+1/a(i)
end do
r=1/r
f1=r
end function f1

real function f2(n)
real::r,n,i,a(100)
do i=1,n,1
write(*,*)'Dose to r:',i
read(*,*)a(i)
r=r+a(i)
end do
f2=r
end function f2

Askisi_19 !Μετατροπή από celsiou σε farenait και το αντίστροφο μέσω συνάρτησης-ver1

program f_c
implicit none
real::f1,f2,c,f
integer::choise,i,n
write(*,*)'1. Metatroph apo celsiou se farenait'
write(*,*)'2. Metatroph apo farenait se celsiou'
write(*,*)'Give a choise:'
read(*,*)choise
write(*,*)'Dose to aplithos twn arithmos pou tha dwseis gia metatroph:'
read(*,*)n
select case (choise)
case (1)
do i=1,n,1
write(*,*)'Dose tous bathmous celsiou:'
read(*,*)c
write(*,*)f1(c)
end do
case (2)
do i=1,n,1
write(*,*)'Dose tous bathmous farenait'
read(*,*)f
write(*,*)f2(f)
end do
case default
write(*,*)'WRONG CHOISE'
end select
pause 'Pata ENTER gia na synexiseis'
stop
end program f_c

real function f1(c)
real::c
f1=(9*c+160)/5
end function f1

real function f2(f)
real::f
f2=(5*f-160)/9
end function f2

Askisi_20 ! Μετατροπή από celsiou σε farenait και το αντίστροφο μέσω συνάρτησης-ver2

program f_c
implicit none
real::f1,f2,c(100),f(100)
integer::choise,i,n
write(*,*)'1. Metatroph apo celsiou se farenait'
write(*,*)'2. Metatroph apo farenait se celsiou'
write(*,*)'Give a choise:'
read(*,*)choise
write(*,*)'Dose to aplithos twn arithmos pou tha dwseis gia metatroph:'
read(*,*)n
select case (choise)
case (1)
do i=1,n,1
write(*,*)'Dose tous bathmous celsiou:'
read(*,*)c(i)
end do
do i=1,n,1
write(*,*)c(i),'celsiou',f1(c(i)),'farenait'
end do
case (2)
do i=1,n,1
write(*,*)'Dose tous bathmous farenait'
read(*,*)f(i)
end do
do i=1,n,1
write(*,*)f(i),'farenait',f2(f(i)),'celsiou'
end do
case default
write(*,*)'WRONG CHOISE'
end select
pause 'Pata ENTER gia na synexiseis'
stop
end program f_c

real function f1(c)
real::c
f1=(9*c+160)/5
end function f1

real function f2(f)
real::f
f2=(5*f-160)/9
end function f2

Δεδομένα δοκιμής της άσκησης 20:


Choise=1
C(1)=32
c(2)=40
c(3)=100

Θα βγάλει στην οθόνη

32c 89,6f
40c 104f
100c 212f

Choise=2
f(1)=89,6f
f(2)=104f
f(3)=212f

Θα βγάλει στην οθόνη

89,6f 32c
104f 40c
212f 100c

Choise=3
Θα βγάλει στην οθόνη
WRONG CHOISE

Askisi_21 !Lesson1 Υπολογισμός της συνάρτησης f(x)=ex με τη σειρά Maclaurin.

program askisi1
implicit none
real::e,x,sum,pro_sum
integer::choise,v,parag,i
write(*,*)'1. Ypologismos me exp(x)'
write(*,*)'2. Ypologismos me Maclaurin'
write(*,*)'3.Exodos'
Write(*,*)
write(*,*)'Give a choise:'
read(*,*,iostat=i)choise
select case (choise)
case (1)
write(*,*)'Dose to X:'
read(*,*)x
write(*,*)exp(x)
case (2)
write(*,*)'Dose to X kai to e:'
read(*,*)x,e
sum=0
pro_sum=0
do v=0,100,1
sum=sum+(x**v/parag(v))
if (abs(sum-pro_sum)<=e)exit
pro_sum=sum
end do
write(*,*)sum
case (3)

case default
write(*,*)'WRONG'
end select
stop
end program askisi1

recursive function parag(n) result(apotelesma)

integer::n,apotelesma
if (n==0) then
apotelesma=1
else
apotelesma=parag(n-1)*n
end if
end function parag

Askisi_22 !Άσκηση με Subroutine.

program FinalTest
implicit none
real::n1,n2,apot1
integer::choise
character::apantisi
1 write(*,*)'1.(+)'
write(*,*)'2. (-)'
write(*,*)'3. (*)'
write(*,*)'4. (/)'
write(*,*)'Give a choise:'
read(*,*)choise
write(*,*)'Dose tous dyo arithmous:'
read(*,*)n1,n2
select case (choise)
case(1)
call pros(n1,n2,apot1)
write(*,*)apot1
case(2)
call afer(n1,n2,apot1)
write(*,*)apot1
case(3)
call pol(n1,n2,apot1)
write(*,*)apot1
case(4)
if (n2==0) then
write(*,*)'ERROR'
else
call dier(n1,n2,apot1)
write(*,*)apot1
end if
case default
write(*,*)'WRONG CHOISE'
end select
write(*,*)'gia na synexiseis pata n kai gia exodo pata kati allo:'
read(*,*)apantisi
if (apantisi=='n') then
goto 1
else
goto 2
end if
2 stop
end program FinalTest

subroutine pros(a,b,c)
real::a,b,c
c=a+b
end subroutine pros

subroutine afer(a,b,c)
real::a,b,c
c=a-b
end subroutine afer

subroutine pol(a,b,c)
real::a,b,c
c=a*b
end subroutine pol

subroutine dier(a,b,c)
real::a,b,c
c=a/b
end subroutine dier
 

Σημείωση: Το μήνυμα αυτό γράφτηκε 16 χρόνια πριν. Ο συντάκτης του πιθανόν να έχει αλλάξει απόψεις έκτοτε.

Χρήστες Βρείτε παρόμοια

  • Τα παρακάτω 0 μέλη και 1 επισκέπτες διαβάζουν μαζί με εσάς αυτό το θέμα:
    Tα παρακάτω 0 μέλη διάβασαν αυτό το θέμα:
  • Φορτώνει...
Top