Télécharger la plaquette Cast3M


fr en

Télécharger cenv.eso

Retour à la liste

Numérotation des lignes : 

cenv

  1. C CENV      SOURCE    PV        20/03/30    21:15:45     10567          
  2.       subroutine CENV(colDes,iComm)
  3. C L'operateur CENV (COLlaborateur ENVoyer) permet d'envoyer une liste d'objet en
  4. C argument au collaborateur colDes, donne également en argument
  5. CEn se basant sur le fonctionnement du sauver, le fonctionnement est le
  6. C suivant :
  7. C     -Recuperer la liste des arguments
  8. C     -Verifier que le type des objets est correct
  9. C     -Faire un premier remplissage des piles avec la liste d'argument
  10. C     -Chercher les objets nécessaires pour la liste d'argument
  11. C     -Envoyer cette liste
  12. C     -Recevoir la liste des objets a envoyer
  13. C     -Chercher la taille du buffer et l'allouer
  14. C     -Remplir le buffer
  15. C     -Envoyer le buffer
  16. C     -FIN
  17. C Declaration des variables
  18.       character*(8) typNom
  19.       integer typNum
  20.       integer nArg
  21.       integer iComm
  22.       integer iretou,i,ipile
  23.       integer iPoint,nNoeud
  24.       integer colDes,colMoi
  25.       integer lonBuf
  26.       integer taille
  27.       integer bufPos
  28.       integer nitlac
  29.       integer totCol
  30.       integer tagPre,tagMan,tagObj
  31. C     Variable pour la lecture des entiers
  32.       real*8 xval
  33.       integer ival
  34.       character*512 cval
  35.       logical logval
  36.       integer iob
  37.       integer nbRee,nbCha,nbMot
  38.  
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC COCOLL
  43. -INC SMCOORD
  44. -INC TMCOLAC
  45. -INC CCASSIS
  46. -INC CCNOYAU
  47. C Declaration des types de segment
  48.       segment BUFFER
  49.          character ffer(lonBuf)
  50.       endsegment
  51.       segment PILOC
  52.              real*8 reel(nbRee)
  53.              character*(nbCha)  chara
  54.              integer motdeb(nbMot+1)
  55.       endsegment
  56.       segment LISARG
  57.          character*8 nom(nArg)
  58.          integer     adress(nArg)
  59.       endsegment
  60.       pointeur argume.LISARG
  61.       pointeur lisMan.LISARG
  62.       pointeur lisReq.LISARG
  63. c        Pointeur des gestions des assistants
  64. c      pointeur mestra.MESTRA
  65.       pointeur piles.LISPIL
  66.       pointeur jcolac.ICOLAC
  67.       pointeur lcolac.ICOLAC
  68.       pointeur pilReq.ICOLAC
  69.       pointeur jtlacc.ITLACC
  70.       pointeur jlisse.ILISSE
  71.       pointeur bu.BUFFER
  72.       pointeur pilLoc.PILOC
  73.       if(iimpi.ge.7) then
  74.       write(ioimp,*) 'Entre dans CENV'
  75.       write(ioimp,*) icomm
  76.       endif
  77.       nbRee=0
  78.       nbCha=0
  79.       nbMot=0
  80.       lonBuf=0
  81.       colMoi=0
  82.       tagPre=12
  83.       tagMan=14
  84.       tagObj=15
  85.       totCol=0
  86.       piles = piComm
  87. C     write(ioimp,*) 'piComm dans cenv',piles
  88.       segact piles
  89. C     Il faut garder le segments piles actifs, cela permet de bloquer
  90. C     en ecriture le segment et donc de bloquer les appels a cfin
  91. C     avant que les envois et receptions ne soient termines
  92. C     Ce blocage n'empeche pas des envois / receptions simultanee car
  93. C     on active en lecture, seul cdeb et cfin activent en mod
  94.       segini pilLoc
  95.       pilLoc.motDeb(1)=1
  96.       call mpinbc ( totCol)
  97.       if(icomm.eq.mpiComCa) then
  98.          if(colDes.gt.totCol.or.colDes.lt.1) then
  99.             write(ioimp,*)'Le numero du destinataire n''est pas correct'
  100.             write(ioimp,*) colDes
  101.             moterr( 1: 8) = 'collabor'
  102.             call erreur(645)
  103.             return
  104.          else
  105.             if(iimpi.ge.6) then
  106.                write(ioimp,*) 'Debut de l''envoi au collaborateur ',
  107.      &      (colDes)
  108.             endif
  109.          endif
  110.       else
  111.          if(iimpi.ge.6) then
  112.             write(ioimp,*) 'Debut de l''envoi vers l''exterieur ',
  113.      &      icomm, colDes
  114.          endif
  115.       endif
  116.       call mpirgc ( colMoi )
  117.  
  118.       nArg=0
  119.       segini argume
  120. C     INTEXT est une variable globale (cf CCNOYAU)
  122.       typNom=' '
  123. C lecture d'un possible premier argume
  124.       call quetyp(typNom,0,iretou)
  125.       do while(iretou.eq.1)
  126. c------- on controle la validite du type demande
  127.       typNum=0
  128.       call typfil (typNom,typNum)
  129.       if (typNum.eq.1 ) then
  130.          call lirobj(typNom,iPoint,1,iretou)
  131.          elseif (typNum.eq.2 ) then
  132.          call lirobj(typNom,iPoint,1,iretou)
  133.          elseif (typNum.eq.3 ) then
  134.          call lirobj(typNom,iPoint,1,iretou)
  135.          elseif (typNum.eq.24) then
  136.          call lirlog(logval,1,iretou)
  137.          if(logval) then
  138.             iPoint=1
  139.          else
  140.             iPoint=0
  141.          endif
  142.          elseif (typNum.eq.25) then
  143.          call lirree(xval,1,iretou)
  144.          nbRee=nbRee+1
  145.          segadj pilLoc
  146.          iPoint=nbRee
  147.          pilLoc.reel(iPoint)=xval
  148.          elseif (typNum.eq.26) then
  149.          call lirent(ival,1,iretou) 
  150.          iPoint=ival
  151.          elseif (typNum.eq.27) then
  152.          call lircha(cval,1,ival)
  153.          nbMot=nbMot+1
  154.          nbCha=nbCha+ival
  155.          segadj pilLoc
  156.          iPoint=nbMot
  157.          pilLoc.motDeb(nbMot+1)=nbCha+1
  158.          pilLoc.chara(nbCha-ival+1:nbCha)=cval(1:ival)
  159.          elseif (typNum.eq.32) then
  160.          call lirobj(typNom,iPoint,1,iretou)
  161.          elseif (typNum.eq.33) then
  162.          call lirobj(typNom,iPoint,1,iretou)
  163.          elseif (typNum.eq.38) then
  164.          call lirobj(typNom,iPoint,1,iretou)
  165.          elseif (typNum.eq.39) then
  166.          call lirobj(typNom,iPoint,1,iretou)
  167.       else
  168.          moterr(1:8)=typNom
  169.          call erreur(39)
  170.          return
  171.       endif
  172.  
  173. c------- le type est ok, on l'ajoute a la liste
  174.       nArg=nArg+1
  175.       segadj argume
  176.       argume.nom(nArg)=typNom
  177.       argume.adress(nArg)=iPoint
  178.       if(iimpi.ge.7) then
  179.          write(ioimp,*) 'Ajout d un argument de type ',typNom
  180.          write(ioimp,*) 'et de pointeur ',iPoint
  181.       endif
  182. C        On test s'il y a encore qq ch dans la pile pour savoir si on
  183. C        refait une iteration ou pas
  185.       typNom=' '
  186.       call quetyp(typNom,0,iretou)
  187.       enddo
  188.       iretou = 0
  189.  
  190.       if (nArg.eq.0) then
  191.          segdes argume
  192.          segsup argume
  193.          moterr(1:8)='        '
  194.          call erreur(37)
  195.       else
  196. C         write(ioimp,*) 'Nombre d'objets a sauver', nArg
  197.       endif
  198. C     Si on est le propre destinataire, inutile d'enoyer les objets
  199.       if(colMoi+1.ne.colDes.or.icomm.ne.mpicomCa) then
  200. C Premier remplissage des piles avec la liste d'arguments lus
  201.          typNom='        '
  202.          typNum=-1
  203.          call typfil(typNom,typNum)
  204.          nitlac=-typNum
  205.          call crepil(pilReq,nitlac)
  206. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  207. CC *   attention aux assistants ....
  208. *te         if (nbesc.ne.0) then
  209. C          if (iimpi .eq. 1234)
  210. c        write(ioimp,*) 'il faut bloquer les assistants'
  211. C         mestra=imestr
  212. C         segact mestra*mod
  213. *te            call threadii
  214. C         call ooofrc(1)
  215. C         call setass(1)
  216. *te         endif
  217. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  218.          call filllu(argume,pilReq)
  219. C Second remplissage avec les objets references
  220.          segact argume*mod
  221.          segact mcoord
  222.          call fillpi(pilReq)
  223.          segdes mcoord
  224. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  225. *te         if (nbesc.ne.0) then
  226. C         call setass(0)
  227. C         call ooofrc(0)
  228. C         segact mestra
  229. *te            call threadis
  230. *te         endif
  231. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  232.          segact pilReq*mod
  233. C      write(ioimp,*) 'activation du segment de comm', colDes, jcolac
  234.             lcolac = piles.proc(colDes)
  235.             segini,jcolac=lcolac
  236. C         segact jcolac*mod
  237.             jlisse = jcolac.ilissg
  238.             segact jlisse*mod 
  239.             do ipile=1,jcolac.kcola(/1)
  240.             jtlacc=jcolac.kcola(ipile)
  241.             if(jtlacc.gt.0) segact jtlacc*mod
  242.             enddo 
  243.             call cinipi(jcolac)
  244. C Ajout des piles pilReq dans jcolac et renumerotation de pilReq
  245.          call cajppi(pilReq,jcolac,.true.)
  246. C      write(ioimp,*) 'desactivation du segment de comm', colDes, jcolac
  247.             do ipile=1,jcolac.kcola(/1)
  248.             jtlacc=jcolac.kcola(ipile)
  249.             if(jtlacc.gt.0) segdes jtlacc
  250.             enddo 
  251.             segdes jlisse
  252.  
  253. C Conversion des piles pilReq et list lisReq
  254.          nArg=0
  255.          segini lisReq
  256. C         call savseg(lisReq)
  257.          call cpi2li(pilReq,lisReq)
  258.          call clibpi(pilReq)
  259.          if(iimpi.ge.7) then
  260.             write(ioimp,*) 'Objets dans la liste des prerequis:'
  261.             do i=1,lisReq.adress(/1)
  262.             write(ioimp,*) i,lisReq.adress(i),lisReq.nom(i)
  263.             enddo
  264.          endif
  265. C Mesure de la liste lisReq
  266.          lonBuf=0
  267.          call cmearg(lisReq,taille)
  268.          lonBuf = lonBuf + taille
  269. C Allocation du buffer
  270.          segini bu
  271.          bufPos=0
  272. C        Paquettage de la liste des objets necessaires
  273.          call cpaarg(lisReq,bu,bufPos)
  274.          segsup lisReq
  275. C     Envoi de la liste des objets necessaires
  276.          if(iimpi.ge.6) then
  277.             write(ioimp,*) 'Envoi de la liste des prerequis au coll',
  278.      &       colDes
  279.             write(ioimp,*) 'Longueur du buffer :', bufPos
  280.          endif
  281.          call mpiEnv(colDes,iComm,tagPre,bu,bufPos)
  282. c        Reception de la liste des objets a envoyer
  283.             if(iimpi.ge.6) then         
  284.                write(ioimp,*) 'Attente de la liste des objets a envoyer'
  285.             endif
  286.             call mpiRcv(colDes,iComm,tagMan,bu)
  287.             bufPos = 0
  288.             nArg=0
  289. C        Extraction de la liste des objets a envoyer du buffer
  290.             call cuparg(bu,bufPos,lisMan)
  291.             segsup bu
  292. C        Conversion dans lisMan des positions dans la pile en pointeur
  293.             segact jlisse
  294.             do ipile=1,jcolac.kcola(/1)
  295.             jtlacc=jcolac.kcola(ipile)
  296.             if(ipile.lt.24.or.ipile.gt.27) then
  297.                if(jtlacc.gt.0) segact jtlacc
  298.             else
  299.                if(jtlacc.gt.0) segact jtlacc*mod
  300.             endif
  301.             enddo 
  302.             if(iimpi.ge.6) then         
  303.                write(ioimp,*) 'Liste des objets manquants recus'
  304.             endif
  305.          call clip2s(jcolac,lisMan)
  306. C        Calcul de la taille du message et allocation
  307.          lonBuf=0
  308.          call cmelis(lisMan,jcolac,taille)
  309.          lonBuf = lonBuf + taille
  310.          call cmeplo(pilLoc,taille)
  311.          lonBuf = lonBuf + taille
  313.          lonBuf = lonBuf + taille
  314. C         write(ioimp,*) 'allocation d un buffer de taille',lonBuf
  315.          segini bu
  316.          bufPos=0
  317. C     Paquettage des objets
  318.          if(iimpi.ge.6) then
  319.             write(ioimp,*) 'Paquettage des objets'
  320.          endif
  321.          call cpaplo(pilLoc,bu,bufPos)
  322.          segsup pilLoc
  323.          segact mcoord
  324.          nNoeud=nbpts
  325.          call cpalis(lisMan,jcolac,nNoeud,bu,bufPos)
  326.          segdes mcoord
  327.  
  328.          segsup lisMan
  329. C     Renumerotation de la liste des arguments
  330.          call clis2p(jcolac,argume)
  331.             do ipile=1,jcolac.kcola(/1)
  332.             jtlacc=jcolac.kcola(ipile)
  333.             if(ipile.lt.24.or.ipile.gt.27) then
  334.                segdes jtlacc
  335.             else
  336. C                  call libseg(jtlacc)
  337.                segsup jtlacc
  338.                jcolac.kcola(ipile)=0
  339.             endif
  340.             enddo 
  341.             segdes jlisse 
  342.             segsup jcolac
  343.  
  344. C     Paquettage des la liste des objets a retourner
  345.          if(iimpi.ge.6) then
  346.             write(ioimp,*) 'Paquettage de la liste des arguments'
  347.          endif
  348.          call cpaarg(argume,bu,bufPos)
  349.          segdes argume
  350. C         call libseg(argume)
  351.          segsup argume
  352. C     Envoi du message
  353.          if(iimpi.ge.6) then
  354.             write(ioimp,*) 'Envoi des objets au coll',colDes
  355.          endif
  356. C         if (nbesc.ne.0) then
  357. C            segdes mestra
  358. C         endif
  359.          call mpiEnv(colDes,iComm,tagObj,bu,bufPos)
  360.          if(iimpi.ge.6) then
  361.             write(ioimp,*) 'Fin de l''envoi a ',colDes
  362.          endif
  363.       else
  364. C         Cas d'un message envoyer a soi meme
  366.          lonBuf = taille
  367.          call cmeplo(pilLoc,taille)
  368.          lonBuf = lonBuf+taille
  369. C         write(ioimp,*) 'allocation d un buffer de taille',lonBuf
  370.          segini bu
  371.          bufPos=0
  372.          call cpaplo(pilLoc,bu,bufPos)
  373.          segsup pilLoc
  374.          call cpaarg(argume,bu,bufPos)
  375.          segdes argume
  376.          segsup argume
  377. C        Envoi du message
  378.          if(iimpi.ge.6) then
  379.             write(ioimp,*) 'Envoi du message a soi meme '
  380.          endif
  381.          call mpiEnv(colDes,iComm,tagObj,bu,bufPos)
  382.       endif
  383.       segdes piles
  384.  
  385. C     L'envoi est termine, on peut debloquer le segment piles (cf
  386. C     remarque lors de l'activation de ce segment)
  387. C      write(ioimp,*) 'Sortie de CENV'
  388.       end
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales