IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Les notions de base du Fortran

Support de cours


précédentsommairesuivant

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.finkitxmlcodelatexdvp

On pourra imprimer les solutions à l'aide de l'instruction :

 
Sélectionnez
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 :

 
Sélectionnez
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}finkitxmlcodelatexdvp

La 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

 
Sélectionnez
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

 
Sélectionnez
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 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

 
Sélectionnez
1.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

 
Sélectionnez
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.
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

précédentsommairesuivant

Copyright © 2006 Patrick Corde et Anne Fouilloux. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.