c ------------------------------------------------------------------- c affichage d'un tableau de réels c arguments non modifiés : le tableau (tab), le nombre d'éléments (n) c ------------------------------------------------------------------- subroutine affiche(tab,n) implicit none integer n real tab(*) integer i print *,'le tableau contient ',n,' elements' do 10 i=1,n print *,i, '->', tab(i) 10 continue end subroutine affiche c ------------------------------------------------------------------- c saisie d'un tableau de réels (son nombre d'éléments n puis les n éléments) c arguments modifiés : le tableau (tab), le nombre d'éléments (n) c arguments non modifiés : la dimension réelle de tab (max) c ------------------------------------------------------------------- subroutine saisie(tab,n,max) implicit none integer n,max real tab(*) integer i print *,'combien d elements ?' read *,n if (n.gt.max.or.n.le.0) then print *,'pas possible !' stop endif do 20 i=1,n print *,i, '->' read *,tab(i) 20 continue end subroutine saisie c ------------------------------------------------------------------- c calcul de la moyenne d'un tableau de réels c arguments non modifiés : le tableau (t), le nombre d'éléments (nb) c ------------------------------------------------------------------- real function moyenne(t,nb) implicit none integer nb real t(*) integer i real somme somme=0 do 30 i=1,nb somme=somme+t(i) 30 continue moyenne=somme/nb end function moyenne c ------------------------------------------------------------------- c supression d'un élément d'un tableau de réels c arguments modifiés : le tableau (tab), le nombre d'éléments (nb) c ------------------------------------------------------------------- subroutine suprelem(tab,nb) implicit none integer nb real tab(*) integer i,sup print *,'note a supprimer' read *,sup if(sup.le.0.or.sup.gt.nb)return nb=nb-1 do 40 i=sup,nb tab(i)=tab(i+1) 40 continue end subroutine suprelem c ------------------------------------------------------------------- c rotation vers le bas des éléments d'un tableau de réels c arguments modifiés : le tableau (tab) c arguments non modifiés : le nombre d'éléments (nb) c ------------------------------------------------------------------- subroutine rotabas(tab,nb) implicit none integer nb real tab(*) integer i real tmp tmp=tab(1) do 50 i=2,nb tab(i-1)=tab(i) 50 continue tab(nb)=tmp end subroutine rotabas c ------------------------------------------------------------------- c rotation vers le haut des éléments d'un tableau de réels c arguments modifiés : le tableau (tab) c arguments non modifiés : le nombre d'éléments (nb) c ------------------------------------------------------------------- subroutine rotahaut(tab,nb) implicit none integer nb real tab(*) integer i real tmp tmp=tab(nb) do 60 i=nb,2,-1 tab(i)=tab(i-1) 60 continue tab(1)=tmp end subroutine rotahaut c ------------------------------------------------------------------- c tri des éléments d'un tableau de réels c arguments modifiés : le tableau (tab) c arguments non modifiés : le nombre d'éléments (nb) c ------------------------------------------------------------------- subroutine trier(tab,nb) implicit none integer nb real tab(*) integer i,j,pp real tmp do 70 i=1,nb-1 pp=i do 71 j=i+1,nb if(tab(j).lt.tab(pp)) pp=j 71 continue if(i.ne.pp) then tmp=tab(i) tab(i)=tab(pp) tab(pp)=tmp endif 70 continue end subroutine trier c ------------------------------------------------------------------- c affichage du menu c arguments : aucun c ------------------------------------------------------------------- subroutine affmenu print *,'1 -> saisie' print *,'2 -> affiche' print *,'3 -> calcul de moyenne ' print *,'4 -> ajouter note' print *,'5 -> supprimer note' print *,'6 -> décaller vers le bas' print *,'7 -> décaller vers le haut' print *,'8 -> trier par ordre croissant' print *,'0 -> sortie' end subroutine affmenu c ------------------------------------------------------------------- c programme principal c il DOIT s'appeller main dans certains compilateurs program main implicit none c déclarations des fonctions utilisées real moyenne integer dim parameter(dim=100) real tableau(dim) integer nb,rep rep=-1 do while(rep.ne.0) call affmenu read *,rep if (rep.eq.1) then call saisie(tableau,nb,dim) elseif (rep.eq.2) then call affiche(tableau,nb) elseif (rep.eq.3) then print *,'la moyenne est ',moyenne(tableau,nb) elseif (rep.eq.4.and.nb.lt.dim) then nb=nb+1 print *,'note a rajouter :' read *,tableau(nb) elseif (rep.eq.5) then call suprelem(tableau,nb) elseif (rep.eq.6) then call rotabas(tableau,nb) elseif (rep.eq.7) then call rotahaut(tableau,nb) elseif (rep.eq.8) then call trier(tableau,nb) endif enddo end program main