Sources Esope | Cast3M

coll
C COLL      SOURCE    GF238795  18/01/22    21:15:15     9702           
      subroutine COLL
      integer motCle
      integer mesure
      integer apIdC
      integer corres
      integer iexte
      integer alead,blead
      integer interco,itag
      character*10 nomExt
      INTEGER OOOVAL
      real*8 starttime, endtime;
*      real*4 vtime, ttime(2)
*      real*4 vtim0, ttim0(2)
      real*8 temecou
      character*9 mot(10)
      character*9 motmes(2)
      character*9 motver(1)
      data motmes/'MESU','MESO'/
      data mot/'DEBUT','FIN','RANG','NOMBRE','ENVOYER','RECEVOIR',
     &         'STOP','HORL','PID','POINTEUR'/
-INC SMCOORD
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC COCOLL
-INC CCASSIS
-INC TMCOLAC
      segment TABICO
         integer  leau(nTab)
      endsegment
      pointeur itab.TABICO
      pointeur piles.LISPIL
      corres = 0
 
      call lirmot(motmes,2,mesure,0)
 
      segdes mcoord
 
      call lirmot(mot,10,motcle,1)
      if(motcle.eq.0) then
         call erreur (498)
         return
      endif
      if(motcle.lt.9.and.(motcle.ge.2.and.piComm.le.0)) then
         write(ioimp,*) 'Impossible d''utiliser MPI sans l''initialiser'
         write(ioimp,*) 'Appelez COLL DEBUT avant tout autre appel a
     &COLL'
         call erreur(223)
         return
      endif
      if(ierr.eq.0) then
         if(mesure.ge.1) then
            call mpihor(starttime)
         endif
         if( motcle.eq.1) then
C        Initialisation des communications
            call lirmot(motext,3,iexte,0)
            if(iexte.le.0) then
C Initialisation globale
            CALL CDEB
C On sauvegarde le comm de castem comme un autre intercommunicateur               
            else
               if(piComm.le.0) then
                  write(ioimp,*) 'Impossible d''utiliser MPI sans 
     &l''initialiser'
                  write(ioimp,*) 'Appelez COLL DEBUT avant tout autre
     &appel a COLL'
                  call erreur(223)
                  return
               endif
C initialisation des intercommunicteurs
               itab = colltopo
               segact itab
               apIdC = idcext(1)
               nomExt = motext(iexte)
               iexte = idcext(iexte)
               alead = -3
               blead = -3
               itag = (apIdC * iexte + 1 ) * (apIdC + iexte)
 
C Recherche des leaders (Bring me your leader)
               do itop=1,itab.leau(/1)
                  if ((itab.leau(itop).eq.apIdC).and.(alead.lt.0)) then
                     alead = itop - 1
                  endif
                  if ((itab.leau(itop).eq.iexte).and.(blead.lt.0)) then
                     blead = itop - 1
                  endif
               enddo
               if(blead.eq.-3) then
                  write(ioimp,12) nomExt
12    format('Impossible de trouver d''instance de ',A10)
                   return
               endif
               call mpiicc(alead,blead,itag,iexteco)
               itab = cointeco
               segact itab*mod
               ntab = itab.leau(/1)
               if(ntab.lt.iexte) then
                  ntab = iexte
                  segadj itab
               endif
               itab.leau(iexte) = iexteco
               segdes itab
            endif
 
         else if( motcle.eq.2) then
C        Fermeture des communications
C        On bloque les assistants pour être sur que les comm sont finis
         if (nbesc.ne.0) then
            mestra=imestr
            segact mestra*mod
            call setass(1)
            NOMLUS=NOMLU
            NOMLU=1
            CALL CFIN
            segdes mestra
            NOMLU=NOMLUS
            call setass(0)
         else
            CALL CFIN
         endif
            itab = cointeco
            segact itab*mod
            call libseg(itab)
            segdes itab
            segsup itab
         else if( motcle.eq.3) then
C        Recuperation du rang du colloborateur
            CALL RGCO
         else if( motcle.eq.4) then
C        Recuperation du nombre total de collaborateurs
            CALL NBCO
         else if( motcle.eq.5) then
C        Envoi d'un message
            call lirmot(motext,3,iexte,0)
            call lirent(corres,1,iretou)
            if(iexte.le.0) then
               call lirmot(motext,3,iexte,0)
            endif
            if(iexte.le.0) then
               iexte = 1
            endif
            if (ierr.ne.0) then
               write(ioimp,*) 'Probleme lors de la lecture du
     &destinataire'
               return
            endif
121    format('L''intercommunicateur avec ',A10,
     &' n''a pas ete initialisse')
               itab = cointeco
               segact itab
               nomExt = motext(iexte)
               iexte= idcext(iexte)
               if(iexte.le.itab.leau(/1)) then
                  iexte = itab.leau(iexte)
                  if(iexte.le.0) then
                  write(ioimp,121) nomExt
                     call erreur(223)
                     return
                  endif
               else
                  write(ioimp,121) nomExt
                  call erreur(223)
                  return
               endif
               segdes itab
               CALL CENV(corres,iexte)
         else if( motcle.eq.6) then
C        Reception d'un message
C            segact mcoord*mod
            call lirmot(motext,3,iexte,0)
            call lirent(corres,1,iretou)
            if(iexte.le.0) then
               call lirmot(motext,3,iexte,0)
            endif
            if(iexte.le.0) then
               iexte = 1
            endif
            if (ierr.ne.0) then
               write(ioimp,*) 'Probleme lors de la lecture du
     &destinataire'
               return
            endif
               itab = cointeco
               segact itab
               nomExt = motext(iexte)
               iexte= idcext(iexte)
               if(iexte.le.itab.leau(/1)) then
                  iexte = itab.leau(iexte)
                  if(iexte.le.0) then
                     write(ioimp,121) nomExt
                     call erreur(223)
                     return
                  endif
               else
                  write(ioimp,121) nomExt
                  call erreur(223)
                  return
               endif
               segdes itab
               CALL CREC(corres,iexte)
         else if( motcle.eq.7) then
            if (nbesc.ne.0) then
               mestra=imestr
               segact mestra*mod
               write(ioimp,*) 'STOP'
               segdes mestra
            endif
         else if( motcle.eq.9) then
            ipid = getpid();
            call ecrent(ipid)
         else if( motcle.eq.8) then
            call mpihor(temecou)
            call ecrree(temecou)
         else if( motcle.eq.10) then
            CALL cpoint
         endif
         if(mesure.ge.1) then
            call mpihor(endtime)
            temecou = endtime - starttime
*         print *, 'elapsed:', vtime-vtim0, ', user:', ttime(1)-ttim0(1),
*     &   ', sys:', ttime(2)-ttim0(2)
         endif
         if(mesure.eq.1) then
           write(IOIMP,*) 'Appel a COLL ', mot(motcle), corres,
     &     ' : Temps passe : ', temecou
         endif
         if(mesure.ge.2) then
           call ecrree(temecou)
         endif
      endif
      end