×
Επεξεργασία Προφίλ Επεξεργασία Avatar Επεξεργασία Υπογραφής Επεξεργασία Επιλογών E-mail και Κωδικός Ρυθμίσεις Ειδοποιήσεων
×
Αποσύνδεση Οι Συνδρομές μου Το Προφίλ μου Τα Posts μου Τα Threads μου Λίστα Επαφών Αντιδράσεις σε Posts μου Παραθέσεις των Posts μου Αναφορές σε Εμένα Ενέργειες Συντονιστών Αόρατος Χρήστης
Τι;
Πως;
Ταξινόμηση
Που;
Σε συγκεκριμένη κατηγορία;
Ποιος;
Αποτελέσματα Αναζήτησης
Συμπληρώστε τουλάχιστον το πεδίο Τι;

Το e-steki είναι μια από τις μεγαλύτερες ελληνικές διαδικτυακές κοινότητες με 67,804 μέλη και 2,441,295 μηνύματα σε 76,714 θέματα. Αυτή τη στιγμή μαζί με εσάς απολαμβάνουν το e-steki άλλα 297 άτομα.

Καλώς ήρθατε στο e-steki!

Εγγραφή Βοήθεια

Fortran

teo (Θοδωρής)

Δραστήριο Μέλος

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

O teo έγραψε: στις 15:18, 03-01-08:

#1

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
Πρέπει να συνδεθείτε για να αντιδράσετε σε μηνύματα
Παράθεση
Απάντηση στο θέμα


Χρήστες

  • Τα παρακάτω 0 μέλη και 1 επισκέπτες διαβάζουν μαζί με εσάς αυτό το θέμα.
     
  • (View-All Tα παρακάτω 0 μέλη διάβασαν αυτό το θέμα τις τελευταίες 30 μέρες:
    Μέχρι και αυτή την στιγμή δεν έχει δει το θέμα κάποιο ορατό μέλος

Βρείτε παρόμοια

  • Παρόμοια Θέματα
    • Απορίες και λύσεις για Fortran - Από The Stand
      Το θέμα έχει λάβει 16 απαντήσεις και βρίσκεται στην κατηγορία Προγραμματισμός.
      Το τελευταίο του μήνυμα δημοσιεύτηκε 04-11-12 στις 18:38.
    • Βοήθεια με fortran - Από netpumber
      Το θέμα έχει λάβει 0 απαντήσεις και βρίσκεται στην κατηγορία Φοιτητικά θέματα.
      Το τελευταίο του μήνυμα δημοσιεύτηκε 29-11-10 στις 23:18.
  • Προηγούμενο Θέμα Επόμενο Θέμα