PROJET FORTRAN 77

" LE JEU DE LA VIE "





    Dans le cadre de notre formation d'ingénieur généraliste, nous avons, en 1ère année, des cours d'informatique (Fortran 77 et C). En plus de cours en amphi, nous avons beaucoup de TD pour apprendre à manipuler ces langages informatiques. A la fin, on doit écrire un programme qui répond à certains critères.
    Pour le Fortran 77, nous avions le choix entre 4 sujets :

        - le "tri du couvain"
        - la "piste de chasse"
        - le "robot de Langhton"
        - le "jeu de la vie"

    Le Tri du Couvain : Il était une fois des fourmis qui ne faisaient qu'un seule chose : trier ! Il y avait chez ces fourmis, 2 types d'oeufs : des oeufs de type 1 (jeunes par ex.) et des oeufs de type 2 (vieux par ex.). Les fourmis non chargés, quand elles arrivent sur un oeuf d'un certain type, elles calculent la "concentration locale" en oeuf de même type (par ex. il y a 4 oeufs de ce type dans les 9 cases entourant la fourmi : la concentration est de 4/9.). Suivant la concentration, la fourmi prend l'oeuf avec une certaine probabilité. Si la fourmi est chargée, elle le dépose avec une certaine proba, en fonction de la concentration locale. On comprend donc que plus l'oeuf est isolé, plus il a de chances d'être pris.

    Le Jeu de la Vie : cf ci-dessous

POUR CEUX QUE CA INTERESSE...

    Voilà ce que j'ai écrit pou le Jeu de la Vie en Fortran 77.

    Que fait ce programme ?

En gros, il faut s'imaginer que l'on a un plateau blanc, avec des cellules bleues, et des cellules roses. Ces cellules, au fil des génération meurent, restent en vie ou procréent de nouvelles cellules à certaines  conditions :
    - Une cellule en vie meurt d'isolement si elle a moins de 2 voisines.
    - Une cellule en vie meurt d'étouffement si elle a plus de 3 voisines.
    - Une cellule reste en vie si elle a 2 ou 3 voisines.
    - Une cellule naît si elle a exactement 3 voisines dont 2 de sexes différents.
 
 


c     declaration des variables
c     =========================

      real seed,ran
      integer P(50,50)               ! Plateau de Jeu
      integer i,j,k                  ! entiers pour boucles
      integer nl,nc                  ! nombres de lignes et de colonnes
      integer tours,choix
      integer Voisi(50,50)           ! Matrice de `Voisinage`

c     Hauteur et Largeur du plateau
c     =============================

      write(*,*)'Largeur du plateau (entre 1 et 50)'
      read(*,*)nc
      write(*,*)'Hauteur du plateau (entre 1 et 50)'
      read(*,*)nl

c     Génération de départ
c     ====================

      call init_X(nl,nc,10)

      write(*,*)'Tapez un nombre au hasard'
      read(*,*) seed

      do i=1,nl
         do j=1,nc
            P(i,j)=int(ran(seed)*3)
            call put_carre_X(i,j,P(i,j))
         enddo
      enddo

c     Comment passer à la génération suivante ?
c     =========================================

 10   write(*,*)'Combien de générations ?' ! Demande du nombre de tours
      read(*,*)tours

      do k=1,tours
         call nouvo(P,nl,nc,Voisi)         ! Calcul de la generation suivante

         if (mod(k,100).eq.99)then
            call plbop()
         else
            continue
         endif

         do i=1,nl
            do j=1,nc
               if ((Voisi(i,j).ne.0)) then
                  call put_carre_X(i,j,P(i,j)) ! Affichage de la génération
               else
                  call put_carre_X(i,j,0)
               endif
            enddo
         enddo
      enddo

c     Continuation ou arrêt
c     =====================

 30   write(*,*)'On continue ? (choix=1)'  ! Choix de continuite
      write(*,*)'On arrete ? (choix=2)'    ! ou d'arret
      read(*,*)choix
      if ((choix.eq.1).or.(choix.eq.2)) then
         goto (10,20),choix
      else
         write(*,*)'Mauvaise Frappe'       ! On ne sait jamais.
         goto (30),1                       ! Renvoi a la demande de choix
 20   endif
      end

c     ==============================================================
c     Ecriture du sous-programme de passage a la generation suivante
c     ==============================================================

      subroutine nouvo(P,nl,nc,Voisi)

      integer P(50,50),Voisi(50,50)
      integer Occ(50,50)             ! Matrice d'Occupation
      integer k2,k1,l1,l2
      integer Sexe (50,50)           ! Matrice de `Procreation`

c     Conversion du plateau de jeu en grille d'occupation
c     ---------------------------------------------------

      do i=1,nl
         do j=1,nc
            if (P(i,j).eq.0) then
               Occ(i,j)=0
            else
               Occ(i,j)=1
            endif
         enddo
      enddo

c     Conversion de la grille d'occupation en grille de voisinage
c     +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      do i=1,nl
         do j=1,nc

            k1=mod(j-1,nc)   ! On prend j entre 1 et nc
            k2=mod(j+1,nc)   ! donc on a un tore horizontal

            if (k1.eq.0) then
               k1=nc
            elseif (k2.eq.0) then
               k2=nc
               continue
            endif

            l1=mod(i-1,nl)   ! On prend i entre 1 et nc
            l2=mod(i+1,nl)   ! donc on a une sphère

            if (l1.eq.0) then
               l1=nc
            elseif (l2.eq.0) then
               l2=nc
               continue
            endif
 

            Voisi(i,j)=Occ(l1,k1)+Occ(l1,j)+Occ(l1,k2)+Occ(i,k1)
     &                 +Occ(i,k2)+Occ(l2,k1)+Occ(l2,j)+Occ(l2,k2)

            Sexe(i,j)=P(l1,k1)+P(l1,j)+P(l1,k2)+P(i,k1)
     &               +P(i,k2)+P(l2,k1)+P(l2,j)+P(l2,k2)

         enddo
      enddo

c     Conditions de conservation ou de génération de cellules.
c     ========================================================

      do i=1,nl
         do j=1,nc

c     pour les cases vides
c     --------------------

            if (P(i,j).eq.0) then

               if ((Voisi(i,j).eq.3)  .and. ! Il faut 3 voisines
     &              ((Sexe(i,j).gt.3) .and. ! 3 Cellules bleues ne generent rien
     &              (Sexe(i,j).lt.6))) then ! 3 Cellules roses ne generent rien
                  P(i,j)=int(ran(seed)*2+1)    ! Génération d'une cellule
               else
                  P(i,j)=0
               endif

c     pour les cases bleues
c     ---------------------

            elseif (P(i,j).eq.1) then
               if ((Voisi(i,j).eq.2).or.(Voisi(i,j).eq.3)) then
                     P(i,j)=1          ! la cellule reste en vie
                  else
                     P(i,j)=0          ! la cellule meurt
                  endif

c     pour les cases roses
c     --------------------

               elseif (P(i,j).eq.2) then
                  if ((Voisi(i,j).eq.2).or.(Voisi(i,j).eq.3)) then
                     P(i,j)=2          ! la cellule reste en vie
                  else
                     P(i,j)=0          ! la cellule meurt
                  endif

c     en cas d'erreur
c     ---------------

               else
                  write(*,*)'Y a une merde dans ce programme !'
               endif
         enddo
      enddo
      return
      end

     Voilà ! Vous pouvez voir le résultat si vous pouvez compiler du Fortran 77. Plus tard, vous pourrez voir le résultat en image, mais je ne sais pas quand je m'en occuperai.

" LE TRI DU COUVAIN "



    Quelques mots sur ce programme :

    L'action se passe au pays des fourmis. Je m'explique : On considère une fourmilère ( plus précisément la chambre où sont rangés les oeufs ). Dans celle-ci, on a un certain nombre de fourmis qui doivent ranger des oeufs jeunes (rouges) et des oeufs vieux (bleus) en faisant des groupes. Peu importe la couleur de nos oeufs...

    Pour ranger les oeufs, les fourmis se déplacent et ont une certaine probabilité de ramasser un oeuf suivant qu'il est isolé ou non. De même, si les fourmis sont chargées avec un oeuf, elles auront une certaine probabilité de le déposer suivant qu'il y a beaucoup ou pas d'oeufs du même type que celui qu'elles portent.

    Voilà mon exemple de programme :
 

      program Tri_du_couvain
      implicit none

c     déclaration des variables
c     =========================

      real ran,seed
      integer i,j,n               ! Variables de boucles
      integer Nid(50,50)          ! Matrice du Nid
      integer x(100),y(100)       ! Coordonnées des fourmis
      integer nor,nob             ! Nombres d'oeufs rouges, d'oeufs bleus
      integer nf                  ! Nombre de fourmis
      integer tours               ! Nombre de tours
      integer charge(100)         ! Charge de la fourmi
      integer choix               ! Continuation du programme
      integer nl,nc               ! Nombre de lignes et de colonnes

c     Génération de départ
c     ====================

      write(*,*)'Tapez un nombre au hasard'
      read(*,*) seed

      write(*,*)'Nombre de lignes (entre 1 et 50) ?'
      read(*,*)nl

 40   if ((nl.lt.1).or.(nl.gt.50)) then 
         write(*,*)'Mauvaise Frappe'       ! On ne sait jamais.
         goto (40),1                       ! Renvoi a la demande de choix
      endif

      write(*,*)'Nombre de colonnes (entre 1 et 50) ?'
      read(*,*)nc

 41   if ((nc.lt.1).or.(nc.gt.50)) then 
         write(*,*)'Mauvaise Frappe'       ! On ne sait jamais.
         goto (41),1                       ! Renvoi a la demande de choix
      endif

      call init_X(nl,nc,10)

c     Positionnement des oeufs
c     ------------------------

c     Oeufs rouges

      write(*,*)'Combien d`oeufs rouges ?'
      read(*,*)nor

      do while (nor.gt.0)

         i=int(ran(seed)*nl+1)  ! choix d'une ligne
         j=int(ran(seed)*nc+1)  ! choix d'une colonne

         if (Nid(i,j).eq.0)then ! si la case est vide
            Nid(i,j)=1          ! on met un oeuf rouge ( de valeur 1 )

            nor=nor-1           ! on le décompte

            call put_carre_X(i,j,1)
         endif
      enddo

c     Oeufs bleus

      write(*,*)'Combien d`oeufs bleus ?'
      read(*,*)nob

      do while (nob.gt.0)

         i=int(ran(seed)*nl+1)  ! choix d'une ligne
         j=int(ran(seed)*nc+1)  ! choix d'une colonne

         if (Nid(i,j).eq.0)then ! si la case est vide
            Nid(i,j)=2          ! on met un oeuf bleu ( de valeur 2 )

            nob=nob-1           ! on le décompte

            call put_carre_X(i,j,2)
         endif
      enddo

c     Positionnement des fourmis
c     --------------------------

      write(*,*)'Combien de fourmis (entre 1 et 100)?'
      read(*,*)nf

 42   if ((nf.lt.1).or.(nf.gt.100)) then 
         write(*,*)'Mauvaise Frappe'       ! On ne sait jamais.
         goto (42),1                       ! Renvoi a la demande de choix
      endif

      n=1

      do while (n.le.nf)        ! Pour chacune des nf fourmis

         x(n)=0
         y(n)=0

         i=int(ran(seed)*nl+1)  ! choix d'une ligne
         j=int(ran(seed)*nc+1)  ! choix d'une colonne

         if (Nid(i,j).eq.0)then ! si la case est vide

            x(n)=i              ! on enregistre les coordonnées de la fourmi
            y(n)=j
            charge(n)=0         ! Les fourmis ne portent rien
            n=n+1

            call put_carre_X(i,j,10)
         endif

      enddo
 

c     Déplacement des fourmis
c     =======================

 10   write(*,*)'Combien de tours ?'
      read(*,*)tours
 

      do i=1,tours

         call deplace(Nid,nf,x,y,charge,nl,nc)

      enddo

 30   write(*,*)'On continue ? (choix=1)'  ! Choix de continuite 
      write(*,*)'On arrête ? (choix=2)'    ! ou d'arret
      read(*,*)choix
      if ((choix.eq.1).or.(choix.eq.2)) then 
         goto (10,20),choix
      else 
         write(*,*)'Mauvaise Frappe'       ! On ne sait jamais.
         goto (30),1                       ! Renvoi a la demande de choix
 20   endif

      end
 
 

c==============================================================================
c     Sous-Programme de gestion du déplacement des fourmis
c==============================================================================

      subroutine deplace(Nid,nf,x,y,charge,nl,nc)

      integer x(100),y(100),Nid(50,50),charge(100),nf,nl,nc,etat

      do n=1,nf

         call put_carre_X(x(n),y(n),Nid(x(n),y(n))) 
                                ! On efface l'ancien emplacement des fourmis

c     Déplacement de la fourmi
c     ------------------------

         dir=int(ran(seed)*4)+1 ! Tirage de la direction entre 1 et 4

         if (dir.eq.1)then      ! dir = 1
            x(n)=x(n)+1         ! la fourmi va en bas

         elseif(dir.eq.2)then   ! dir = 2
            y(n)=y(n)+1         ! la fourmi va à droite

         elseif(dir.eq.3)then   ! dir = 3
            x(n)=x(n)-1         ! la fourmi va en haut

         else                   ! dir = 4
            y(n)=y(n)-1         ! la fourmi va à gauche
         endif

c     Une " planète Fourmilière "
c     ---------------------------

         if (x(n).eq.0) then    ! si la fourmi sort à gauche
            x(n)=1              ! elle rentre à droite

         elseif (x(n).eq.nl+1) then ! si elle sort à droite
            x(n)=nl              ! elle rentre à gauche

         endif

         if (y(n).eq.0) then    ! si la fourmi sort en haut
            y(n)=1             ! elle rentre en bas

         elseif (y(n).eq.nc+1) then ! si elle sort en bas
            y(n)=nc              ! elle rentre en haut

         endif

         if (Nid(x(n),y(n)).ne.0)then

            call Prise(Nid,x,y,charge,n,nl,nc,seed)

         else

            call Depose(Nid,x,y,charge,n,nl,nc,seed)

         endif

         etat=10+charge(n)
         call put_carre_X(x(n),y(n),etat) !Coloriage de la zone occupée

      enddo

      return

      end
 

c     ==================================
c     Probabilités de Prise et de Dépose
c     ==================================

c     Calcul des Concentrations
c     =========================

      subroutine Concentration(Nid,x,y,Fr,Fb,n,nl,nc)

      integer Nid(100,100),x(100),y(100),n
      integer i,j,abs,ord,nl,nc
      real Fr,Fb

      Fr=0
      Fb=0

      abs=mod(x(n)+i,nl)
      ord=mod(y(n)+j,nc)

c     Concentration en oeufs rouges
c     -----------------------------

      do i=-1,1
         do j=-1,1

            if (abs.eq.0)then
               abs=nl
            endif

            if (ord.eq.0)then
               ord=nc
            endif

            if (Nid(abs,ord).eq.1)then
               Fr=Fr+1
            endif

         enddo
      enddo

c     Concentration en oeufs bleus
c     ----------------------------

      do i=-1,1
         do j=-1,1

            if (abs.eq.0)then
               abs=nl
            endif

            if (ord.eq.0)then
               ord=nc
            endif

            if (Nid(abs,ord).eq.2)then
               Fb=Fb+1
            endif

         enddo
      enddo

      Fr=Fr/9.
      Fb=Fb/9.

      return
      end

c     Prise des oeufs
c     ===============

      subroutine Prise(Nid,x,y,charge,n,nl,nc,seed)

      integer x(100),y(100),Nid(50,50),charge(100),n,nl,nc
      real Ppriser,Ppriseb,ran,seed,r,Fr,Fb

      r=ran(seed)

      call Concentration(Nid,x,y,Fr,Fb,n,nl,nc)

      if ((Nid(x(n),y(n)).eq.1).and.(charge(n).eq.0))then ! Pour un oeuf Rouge

         Ppriser=(0.2/(0.2+Fr))**2

         if (r.le.Ppriser)then
            charge(n)=1
            Nid(x(n),y(n))=0
         endif

      elseif((Nid(x(n),y(n)).eq.2).and.(charge(n).eq.0))then! Pour un oeuf Bleu

         Ppriseb=(0.1/(0.1+Fb))**2

         if (r.le.Ppriseb)then
            charge(n)=2
            Nid(x(n),y(n))=0
         endif
      endif

      return
      end

c     Dépose des oeufs
c     ================

      subroutine Depose(Nid,x,y,charge,n,nl,nc,seed)

      integer x(100),y(100),Nid(50,50),charge(100),n,nl,nc
      real Pposer,Pposeb,ran,seed,r,Fr,Fb

      r=ran(seed)

      call Concentration(Nid,x,y,Fr,Fb,n,nl,nc)

      if ((Nid(x(n),y(n)).eq.0).and.(charge(n).eq.1))then ! Pour un oeuf Rouge

         Pposer=(Fr/(0.1+Fr))**2

         if (r.le.Pposer)then
            charge(n)=0
            Nid(x(n),y(n))=1

      elseif((Nid(x(n),y(n)).eq.0).and.(charge(n).eq.2))then! Pour un oeuf Bleu

         Pposeb=(Fb/(0.1+Fb))**2

         if (r.le.Pposeb)then
            charge(n)=0
            Nid(x(n),y(n))=2
         endif
      endif

      return
      end
 

    Comme pour l'autre programme, une petite visualisation du problème en images suivra mais je ne sais pas quand...