Annexe E : exercices▲
15-1. Exercice 1▲
Écrire un programme permettant de résoudre le système de 2 équations à 2 inconnues :
kitxmlcodelatexdvp\left\{\begin{matrix} u_1x + v_1y = w_1 \\ u_2x + v_2y = w_2 \\ \end{matrix}\right.finkitxmlcodelatexdvpOn pourra imprimer les solutions à l'aide de l'instruction :
PRINT
*, 'X = '
, X, ', Y = '
, Y
15-2. Exercice 2▲
Écrire un programme permettant de calculer les racines du trinôme du 2d degré : kitxmlcodeinlinelatexdvpax^2 + bx + cfinkitxmlcodeinlinelatexdvp. On s'assurera que kitxmlcodeinlinelatexdvpafinkitxmlcodeinlinelatexdvp est non nul. Les racines, si elles existent, pourront être imprimées à l'aide de l'instruction :
PRINT
*, 'X1 = '
, X1, ', X2 = '
, X2
15-3. Exercice 3▲
Écrire un programme calculant le nombre d'Or. Celui-ci peut être obtenu à partir de la suite de Fibonnacci un définie par :
kitxmlcodelatexdvp\begin{matrix} u_0 = 1 \\ u_1 = 1 \\ \dots \\ u_{n+1} = u_n + u_{n-1} \end{matrix}finkitxmlcodelatexdvpLa suite (kitxmlcodeinlinelatexdvp\frac{u_{n+1}}{u_n}finkitxmlcodeinlinelatexdvp) converge vers le nombre d'Or.
15-4. Exercice 4▲
Écrire un programme permettant de déterminer les nombres premiers dans l'intervalle [1,n] à l'aide du crible d'Eratosthène. Il consiste à former une table avec tous les entiers naturels compris entre 2 et n et à rayer (mise à zéro), les uns après les autres, les entiers qui ne sont pas premiers de la manière suivante : dès que l'on trouve un entier qui n'a pas encore été rayé, il est déclaré premier, et on raye tous les multiples de celui-ci.
À la fin du procédé, les nombres non barrés sont des nombres premiers.
On tiendra compte du fait qu'un nombre donné peut déjà avoir été éliminé en tant que multiple de nombres précédents déjà testés.
Par ailleurs, on sait que l'on peut réduire la recherche aux nombres de 2 à kitxmlcodeinlinelatexdvp\sqrt{n}finkitxmlcodeinlinelatexdvp (si un entier non premier est strictement supérieur à kitxmlcodeinlinelatexdvp\sqrt{n}finkitxmlcodeinlinelatexdvp, alors il a au moins un diviseur inférieur à kitxmlcodeinlinelatexdvp\sqrt{n}finkitxmlcodeinlinelatexdvp et aura donc déjà été rayé).
15-5. Exercice 5▲
Écrire un programme permettant de trier un vecteur de nombres en ordre croissant puis décroissant. On s'appuiera sur l'algorithme appelé tri à bulle qui consiste à comparer 2 éléments consécutifs et à les intervertir si nécessaire.
Si après avoir terminé l'exploration du tableau au moins une interversion a été effectuée, on renouvelle l'exploration, sinon le tri est terminé.
15-6. Exercice 6▲
Écrire un programme permettant d'effectuer le produit de 2 matrices A et B. Leurs profils seront définis à l'aide de constantes symboliques. La matrice résultat C sera imprimée à l'écran ligne par ligne avec l'instruction PRINT
puis stockée dans un fichier binaire que l'on nommera « exo6.matrice ».
15-7. Exercice 7▲
Le fichier texte séquentiel « musiciens » est constitué de plusieurs enregistrements, chacun contenant un nom de musicien suivi de ses années de naissance et de mort.
Écrire un programme dont le but est de lire le fichier « musiciens » et de stocker les enregistrements lus dans un fichier binaire à accès direct que l'on nommera « musiciens.bin ».
15-8. Exercice 8▲
Imprimer l'enregistrement du fichier « musiciens » dont le rang est entré au clavier. Son extraction sera effectuée à partir d'un fichier temporaire à accès direct, image du précédent.
On permettra la saisie de plusieurs rangs.
15-9. Exercice 9▲
Les enregistrements des fichiers séquentiels « index_naissance.dat » et « index_deces.dat » sont constitués d'une date de naissance (ou de décès) d'un musicien suivi de son rang dans le fichier « musiciens.bin » créé à l'exercice 7.
Écrire un programme permettant d'imprimer le ou les musiciens dont la date de naissance ou de mort est saisie au clavier. Le type de date désirée sera préalablement déterminé.
La sélection des enregistrements répondant aux choix spécifiés, s'effectuera par l'intermédiaire du fichier d'index correspondant au type de date.
On offrira la possibilité d'effectuer plusieurs recherches.
15-10. Exercice 10▲
Le but de cet exercice est de transformer la matrice stockée dans le fichier binaire « exo6.matrice ». Cette transformation consiste à modifier chaque élément à l'aide d'une fonction paramétrable de la forme kitxmlcodeinlinelatexdvpy = f(x)finkitxmlcodeinlinelatexdvp.
On définira plusieurs fonctions de ce type. La valeur d'un entier lu dans une namelist indiquera la fonction à transmettre en argument de la procédure chargée d'effectuer la transformation.
15-11. Exercice 11▲
Trier les vecteurs lignes puis les vecteurs colonnes d'une matrice en utilisant l'algorithme tri à bulle et la matrice stockée dans le fichier binaire « exo6.matrice ».
On se définira une procédure effectuant le tri (croissant ou décroissant) des différents vecteurs au moyen d'une procédure interne.
15-12. Corrigé de l'exercice 1▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
program
systeme
implicit
none
real
u1,u2
real
v1,v2
real
w1,w2
real
delta, delta_x, delta_y
real
x,y
! Valorisation des coefficients.
u1 = 2; u2 = 4
v1 = 5; v2 = 11
w1 = 7; w2 = 6
! Calcul du déterminant principal.
delta = u1*v2 - u2*v1
if
( delta <
1e-6 ) then
print
*, "Le système n'a pas de solution unique."
stop
4
end
if
! Calcul du déterminant en x.
delta_x = w1*v2 - w2*v1
! Calcul du déterminant en y.
delta_y = u1*w2 - u2*w1
! calcul des solutions.
x = delta_x/delta
y = delta_y/delta
! Impression des solutions.
print
*, "x = "
, x, ", y = "
, y
end
program
systeme
15-13. Corrigé de l'exercice 2▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
program
trinome
implicit
none
real
, parameter
:: epsilon = 1e-6
real
a, b, c
real
delta, r_delta, x1, x2
! Valorisation des coefficients.
a = 3.; b = 7.; c = -11.
! a doit être non nul.
if
( a >
-epsilon .and.
a <
epsilon ) &
stop
"a doit être non nul."
! calcul du déterminant.
delta = b*b - 4*a*c
! cas du déterminant négatif.
if
( delta <
-epsilon ) stop
"Pas de racine réelle."
! cas du déterminant nul.
if
( delta >
-epsilon .and.
delta <
epsilon ) then
x1 = -b/(2*a); x2 = x1
else
! cas du déterminant positif.
r_delta = sqrt
( delta )
x1 = (-b - r_delta)/(2*a); x2 = (-b + r_delta)/(2*a)
end
if
! Impression des racines.
print
*,"x1 = "
, x1, ", x2 = "
, x2
end
program
trinome
15-14. Corrigé de l'exercice 3▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
program
nombre_dor
implicit
none
real
, parameter
:: epsilon = 1.e-5
real
:: u_prec, u_cour
real
:: v_prec, v_cour
real
:: somme
real
:: nombre_or
nombre_or = (1. + sqrt
(5.))/2.
u_prec = 1.; u_cour = 1.
do
v_prec = u_cour/u_prec
somme = u_cour + u_prec
u_prec = u_cour
u_cour = somme
v_cour = u_cour/u_prec
if
( abs
( (v_cour-v_prec)/v_prec ) <
epsilon ) exit
end
do
print
*, "Limite de la suite (vn) : "
, v_cour, &
"Nombre d'or : "
, nombre_or
end
program
nombre_dor
15-15. Corrigé de l'exercice 4▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
program
eratosthene
implicit
none
integer
, parameter
:: n = 1000
integer
, dimension
(n) :: tab_nombres
integer
:: imax
integer
i, j
do
i=2,n
tab_nombres(i) = i
end
do
imax = int
(sqrt
(real
(n)))
do
i=2,imax
if
( tab_nombres(i) /=
0 ) then
do
j=i+1,n
if
( tab_nombres(j) /=
0 .and.
&
mod
( tab_nombres(j), i ) ==
0 ) &
tab_nombres(j) = 0
end
do
end
if
end
do
print
*,"Les nombres premiers entre 1 et "
, n, " sont :"
do
i=2,n
if
( tab_nombres(i) /=
0 ) print
*,tab_nombres(i)
end
do
end
program
eratosthene
15-16. Corrigé de l'exercice 5▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
program
triabulle
implicit
none
integer
, parameter
:: croissant=1, decroissant=2, n=10
real
, dimension
(n) :: tab
real
:: temp
logical
:: tri_termine, expr1, expr2
integer
:: sens, i
! Valorisation du vecteur
data
tab/0.76, 0.38, 0.42, 0.91, 0.25, &
0.13, 0.52, 0.69, 0.76, 0.98/
do
sens=croissant, decroissant ! Sens du tri
do
! Tri
tri_termine = .true.
do
i=2,n
expr1 = sens ==
croissant .and.
tab(i-1) >
tab(i)
expr2 = sens ==
decroissant .and.
tab(i-1) <
tab(i)
if
(expr1 .or.
expr2) then
tri_termine = .false.
temp = tab(i-1); tab(i-1) = tab(i); tab(i) = temp
end
if
end
do
if
(tri_termine) exit
end
do
! Impression du vecteur trié
if
(sens ==
croissant) print
*, "Tri croissant "
if
(sens ==
decroissant) print
*, "Tri décroissant "
print
*, tab
end
do
end
program
triabulle
15-17. Corrigé de l'exercice 6▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
program
produit_matrice
implicit
none
integer
, parameter
:: n = 10, m = 5, p = 3
real
, dimension
(n,m) :: a
real
, dimension
(m,p) :: b
real
, dimension
(n,p) :: c
integer
:: i,j,k
! Valorisation des matrices A et B
data
((a(i,j),j=1,m),i=1,n)/ &
0.00, 0.38, 0.42, 0.91, 0.25, &
0.13, 0.52, 0.69, 0.76, 0.98, &
0.76, 0.83, 0.59, 0.26, 0.72, &
0.46, 0.03, 0.93, 0.05, 0.75, &
0.53, 0.05, 0.85, 0.74, 0.65, &
0.22, 0.53, 0.53, 0.33, 0.07, &
0.05, 0.67, 0.09, 0.63, 0.63, &
0.68, 0.01, 0.65, 0.76, 0.88, &
0.68, 0.38, 0.42, 0.99, 0.27, &
0.93, 0.07, 0.70 ,0.37, 0.44/
data
((b(i,j),j=1,p),i=1,m)/ &
0.76, 0.16, 0.9047, &
0.47, 0.48, 0.5045, &
0.23, 0.89, 0.5163, &
0.27, 0.90, 0.3190, &
0.35, 0.06, 0.9866/
! Produit de matrice.
do
i=1,n
do
j=1,p
c(i,j) = 0.
do
k=1,m
c(i,j) = c(i,j) + a(i,k) * b(k,j)
end
do
end
do
end
do
! Impression de la matrice c.
do
i=1,n
print
*, c(i,:)
end
do
! écriture de la matrice c dans un fichier.
open
( unit=1, file="exo6.matrice"
, &
status="replace"
, form="unformatted"
, &
action="write"
)
write
( 1 ) c
close
( unit = 1)
end
program
produit_matrice
15-18. Corrigé de l'exercice 7▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
program
ecriture_musiciens
character
(len
=80) :: mus
integer
:: ios_mus, val_recl
integer
:: numrec
! Ouverture du fichier des musiciens
! ainsi que d'un fichier en écriture
! à accès direct dans lequel on
! va recopier le fichier précédent.
open
( unit=1, file="musiciens"
, &
form="formatted"
, status="old"
, &
action="read"
, position="rewind"
)
! Calcul de la taille des enregistrements du fichier
! binaire en sortie. (dépend du compilateur).
inquire
( iolength=val_recl ) mus
open
( unit=2, file="musiciens.bin"
, &
status="replace"
, &
form="unformatted"
, access="direct"
, &
action="write"
, recl=val_recl )
! On effectue la copie.
numrec = 0
read
( unit=1, fmt='(a)'
, iostat=ios_mus ) mus
do
while
( ios_mus ==
0 )
numrec = numrec + 1
write
( unit=2, rec=numrec) mus
read
( unit=1, fmt='(a)'
, iostat=ios_mus ) mus
end
do
close
( unit=1 )
close
( unit=2 )
end
program
ecriture_musiciens
15-19. Corrigé de l'exercice 8▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
program
musiciens
implicit
none
character
(len
=80) :: mus
integer
:: ios_mus, ios_stdin
integer
:: numrec, rang
! Ouverture du fichier des musiciens
! ainsi que d'un fichier temporaire
! à accès direct dans lequel on
! va recopier le fichier précédent.
open
( unit=1, file="musiciens"
, &
form="formatted"
, status="old"
, &
action="read"
, position="rewind"
)
open
( unit=2, status="scratch"
, &
form="formatted"
, access="direct"
, &
action="readwrite"
, recl=80 )
! On effectue la copie.
numrec = 0
read
( unit=1, fmt='(a)'
, iostat=ios_mus ) mus
do
while
( ios_mus ==
0 )
numrec = numrec + 1
write
( unit=2, rec=numrec, fmt='(a)'
) mus
read
( unit=1, fmt='(a)'
, iostat=ios_mus ) mus
end
do
close
( unit=1 )
! On demande un rang de musicien.
print
*,"Entrez le rang d'un musicien :"
read
( unit=*, &
fmt=*, &
iostat=ios_stdin ) rang
do
while
( ios_stdin ==
0 )
read
( unit=2, &
rec=rang, &
fmt='(a)'
, &
iostat=ios_mus ) mus
if
( ios_mus /=
0 ) then
print
*,"Le musicien de rang "
, &
rang, "n'existe pas"
else
print
'("musicien de rang",i3," ==> ", a)'
, &
rang,trim(mus)
end
if
print
'(/,"Entrez le rang d''un musicien :")'
read
( unit=*, fmt=*, iostat=ios_stdin ) rang
end
do
close
( unit=2 )
end
program
musiciens
15-20. Corrigé de l'exercice 9▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
program
sequentiel_indexe
implicit
none
character
(len
=19), dimension
(2), parameter
:: f_index = &
(/ "index_naissance.dat"
, "index_deces.dat "
/)
character
(len
=80) :: mus
character
(len
=50) :: prompt_date
integer
:: ios_u1, ios_u2, ios_u3
integer
:: numrec, ios_index, ios_stdin
integer
:: date_saisie, date_lue
integer
:: critere, val_rec
logical
:: trouve
! Ouverture du fichier des musiciens à accès direct en lecture
! et des fichiers d'index.
open
( unit=1, file = f_index(1), &
status="old"
, form="formatted"
, action="read"
, &
iostat=ios_u1 )
open
( unit=2, file = trim(f_index(2)), &
status="old"
, form="formatted"
, action="read"
, &
iostat=ios_u2 )
! Calcul de la taille des enregistrements du fichier
! créé à l'exercice 7. (dépend du compilateur).
inquire
( iolength=val_rec ) mus
open
( unit=3, file="musiciens.bin"
, &
status="old"
, form="unformatted"
, &
access="direct"
, action="read"
, recl=val_rec, &
iostat=ios_u3 )
if
( ios_u1 /=
0 .OR.
ios_u2 /=
0 .OR.
ios_u3 /=
0 ) &
stop
"Erreur à l'ouverture des fichiers"
trait: &
do
do
print
*,'--------------------------------'
print
*,'Choix du critère de recherche : '
print
*,'- par date de naissance (1)'
print
*,'- par date de décès (2)'
print
*,'- QUITTER (3)'
print
*,'--------------------------------'
read
(*, *, IOSTAT=ios_stdin) critere
if
( ios_stdin <
0 ) exit
trait
if
( ios_stdin >
0 ) then
print
'(/,a,/)'
, "Erreur dans la saisie"
else
exit
end
if
end
do
select
case
(critere)
case
(1) ! Recherche par date de naissance.
prompt_date = &
"Entrer une date de naissance d'un musicien"
rewind
( unit=critere )
case
(2) ! Recherche par date de décès.
prompt_date = &
"Entrer une date de décès d'un musicien"
rewind
( unit=critere )
case
default
! Quitter
exit
end
select
! Lecture d'une date.
do
print
*, trim(prompt_date)
read
(*, *, IOSTAT=ios_stdin) date_saisie
if
( ios_stdin <
0 ) exit
trait
if
( ios_stdin >
0 ) then
print
'(/,a,/)'
, "Date erronée!"
else
exit
end
if
end
do
! Recherche de la date saisie dans le fichier d'index.
trouve = .false.
read
( unit=critere, fmt=*, &
iostat=ios_index ) date_lue, numrec
do
while
( ios_index ==
0 )
if
( date_lue ==
date_saisie ) then
! On lit l'enregistrement correspondant.
trouve = .true.
read
( unit=3, rec=numrec ) mus
print
*,trim(mus)
end
if
read
( unit=critere, fmt=*, &
iostat=ios_index ) date_lue, numrec
end
do
if
( .not.
trouve ) &
print
*,"Aucun musicien ne répond au critère indiqué."
print
'(/)'
end
do
trait
close
( unit=1 ); close
( unit=2 ); close
( unit=3 )
end
program
sequentiel_indexe
15-21. Corrigé de l'exercice 10▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
program
mat_transf
implicit
none
integer
, parameter
:: n = 10, m = 3
real
, dimension
(n,m) :: mat
integer
:: choix_methode, ios, num_ligne
real
, external
:: carre, identite, logarithme
real
, intrinsic
:: sqrt
namelist/methode/choix_methode
! Ouverture du fichier contenant la matrice.
open
( unit=1, file="exo6.matrice"
, &
form="unformatted"
, action="read"
, &
status="old"
, position="rewind"
, &
iostat=ios )
if
(ios /=
0) &
stop
'Erreur à l''ouverture du fichier "exo6.matrice"'
! Lecture de la matrice.
read
(1) mat
close
(1)
! Ouverture du fichier contenant
! la namelist "methode".
open
( unit=1, file="exo10.namelist"
, &
form="formatted"
, action="read"
, &
status="old"
, position="rewind"
, &
iostat=ios )
if
(ios /=
0) &
stop
'Erreur à l''ouverture du fichier "exo10.namelist"'
read
( unit=1, nml=methode )
close
( unit=1 )
! Transformation de la matrice à l'aide
! de la méthode choisie.
select
case
( choix_methode )
case
(1)
call
transform( mat, n, m, identite )
case
(2)
call
transform( mat, n, m, carre )
case
(3)
call
transform( mat, n, m, sqrt
)
case
(4)
call
transform( mat, n, m, logarithme )
end
select
! Sauvegarde de la matrice transformée dans
! le fichier "exo6_matrice_transf".
open
( unit=1, file="exo6_matrice_transf"
, &
form="formatted"
, action="write"
, &
status="replace"
, iostat=ios )
if
( ios /=
0 ) &
stop
"Erreur lors de l''ouverture &
&du fichier ""exo6_matrice_transf"""
do
num_ligne=1,n
write
( unit=1, fmt='(3f10.6)'
) mat(num_ligne,:)
end
do
close
( unit=1 )
end
program
mat_transf
! Procédure de transformation.
subroutine
transform( t, n, m, f )
implicit
none
integer
:: n, m, i, j
real
, dimension
(n,m) :: t
real
:: f
do
i=1,n
do
j=1,m
t(i,j) = f(t(i,j))
end
do
end
do
end
subroutine
transform
! Définitions des fonctions de transformation.
function
identite(x)
implicit
none
real
x, identite
identite = x
end
function
identite
function
carre(x)
implicit
none
real
x, carre
carre = x*x
end
function
carre
function
logarithme(x)
implicit
none
real
x, logarithme
logarithme = log
(x)
end
function
logarithme
15-22. Corrigé de l'exercice 11▲
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
program
tri_matrice
implicit
none
integer
, parameter
:: n=10, m=3
real
, dimension
(n,m) :: mat
integer
:: ios
integer
:: i, j
! Lecture de la matrice à trier.
open
( unit=1, &
file="exo6.matrice"
, &
form="unformatted"
, &
status="old"
, &
action="read"
, &
position="rewind"
, &
iostat=ios )
if
( ios /=
0 ) stop
"Erreur à l'ouverture du fichier &
&""exo6.matrice"""
read
( unit=1 ) mat; close
( unit=1 )
call
tri( mat, n, m ) ! Tri de la matrice lue.
! écriture de la matrice triée.
open
( unit=1, file="exo11.matrice_triee"
, &
form="formatted"
, status="replace"
, &
action="write"
, position="rewind"
, &
iostat=ios )
if
( ios /=
0 ) stop
"Erreur à l'ouverture du fichier &
&""exo11.matrice_triee"""
do
i=1,n
write
( unit=1, fmt='(3F7.3)'
) mat(i,:)
end
do
close
( unit=1 )
end
program
tri_matrice
! Procédure de tri.
subroutine
tri( mat, n, m )
implicit
none
integer
:: n, m
real
, dimension
(n,m) :: mat
integer
:: ligne, col
do
ligne=1,n ! Tri des lignes.
call
tri_vecteur( mat(ligne,:), m )
end
do
do
col=1,m ! Tri des colonnes.
call
tri_vecteur( mat(:,col), n )
end
do
contains
! Procédure de tri d'un vecteur.
subroutine
tri_vecteur( v, n )
integer
:: n, i
real
, dimension
(n) :: v
logical
:: tri_termine
do
tri_termine = .true.
do
i=2,n
if
( v(i) >
v(i-1) ) then
tri_termine = .false.
! Utilisation de sections régulières pour
! effectuer l'interversion.
v(i-1:i) = v(i:i-1:-1)
end
if
end
do
if
(tri_termine) exit
end
do
end
subroutine
tri_vecteur
end
subroutine
tri