Télécharger cpachm.eso

Retour à la liste

cpachm
C CPACHM    SOURCE    CB215821  20/11/04    21:15:53     10766          
      subroutine cpachm(pChelm,seg2pi,bu,bufPos)
C=======================================================================
C     COLlaborateur PAQuettage Champ par eleMent
C     Ajout du chpo pChelm dans le buffer d'envoi bu
C=======================================================================
      integer bufPos
      integer lonBuf
      integer nbComp,iComp,nbInf
      integer longTit,longConch
      integer nNoElv,nbElv
      integer nNoEli,nbEli
      integer nbnoel,nconch
      integer nbCons,iCons
      integer ipoPi,iPoint
      integer sePGCD
      integer iNo,iEl
      integer nbInt,nbFloa,nbChar
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC TMCOLAC
      segment BUFFER
      character ffer(lonBuf)
      endsegment
      pointeur pChelm.MCHELM
      pointeur pChaml.MCHAML
      pointeur pElval.MELVAL
 
      pointeur bu.BUFFER
      pointeur seg2pi.ILISSE
 
C      write(ioimp,*) 'Entre dans CPACHM'
C               write(ioimp,*)'Position du buffer',bufPos
      nbInt=0
      nbFloa=0
      nbChar=0
      if (pChelm.ne.0) then
         segact pChelm
         lonBuf=bu.ffer(/2)
         sePGCD=seg2pi.npgcd
C         write(ioimp,*)'Taille du buffer',lonBuf
C        Ecriture du nombre de constituant
         nbCons=pChelm.ichaml(/1)
C         write(ioimp,*)'Ecriture du nombre de constituants',nbCons
         call mpipaI(nbCons,1,bu,bufPos)
         nbInt=nbInt+1
C        Ecriture du nombre d info
         nbInf=pChelm.infche(/2)
C         write(ioimp,*)'Ecriture du nombre du nb d info',nbInf
         call mpipaI(nbInf,1,bu,bufPos)
         nbInt=nbInt+1
         longTit=pChelm.titche(/1)
         call mpipaI(longTit,1,bu,bufPos)
         nbInt=nbInt+1
C         write(ioimp,*)'Ecriture longueur du titre',longTit
         longConch=pChelm.conche(/1)
         call mpipaI(longConch,1,bu,bufPos)
         nbInt=nbInt+1
C         write(ioimp,*)'Ecriture longueur des noms',longConch
C        Ecriture du titre
         call mpipaC(pChelm.titche,longTit,bu,bufPos)
         nbChar=nbChar+longTit
C               write(ioimp,*) 'Ecriture du titre'
C               write(ioimp,*)'Position du buffer',bufPos
C        Ecriture du nom des consituants
         call mpipaC(pChelm.conche,nbCons*longConch,bu,bufPos)
         nbchar=nbChar+nbCons*longConch
C        Ecriture des maillages supports
         do iCons=1,nbCons
C           Ecriture du maillage support
C            write(ioimp,*) 'Maillage support'
         iPoint=pChelm.imache(iCons)
         if(iPoint.ne.0) then
            iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
         else
            iPoPi=0
         endif
C            write(ioimp,*) 'maillage et pile position',iPoint, iPopi
         call mpipaI(iPoPi,1,bu,bufPos)
         nbInt=nbInt+1
         enddo
C        Ecriture des infos
         call mpipaI(pChelm.infche(1,1),nbCons*3,bu,bufPos)
         nbInt=nbInt+nbCons*3
         do iCons=1,nbCons
         iPoint=pChelm.infche(iCons,4)
         if(iPoint.ne.0) then
            iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
         else
            iPoPi=0
         endif
C            write(ioimp,*) 'Pointeur vers sminte et pile',iPoint, iPopi
         call mpipaI(iPoPi,1,bu,bufPos)
         nbInt=nbInt+1
         enddo
         call mpipaI(pChelm.infche(1,5),nbCons*(nbInf-4),bu,bufPos)
         nbInt=nbInt+nbCons*(nbInf-4)
C        Ecriture de l'info de Fourrier
         call mpipaI(pChelm.ifoche,1,bu,bufPos)
         nbInt=nbInt+1
C         write(ioimp,*) 'Info ecrite'
C               write(ioimp,*)'Position du buffer',bufPos
C        Boucle sur les chaml elementaires
         do iCons=1,nbCons
C            write(ioimp,*) 'Chaml :',iCons
         pChaml=pChelm.ichaml(iCons)
         if(pChaml.ne.0) then
            segact pChaml
C              Ecriture du nombre de composante
            nbComp=pChaml.ielval(/1)
C               write(ioimp,*)'Ecriture du nombre de composantes',nbComp
            call mpipaI(nbComp,1,bu,bufPos)
            nbInt=nbInt+1
C              Ecriture du noms des composantes
            call mpipaC(pChaml.nomche(1),nbComp*LOCOMP,bu,bufPos)
            nbChar=nbChar+nbComp*8
C               write(ioimp,*)'Position du buffer',bufPos
 
C              Ecriture du type des composantes
C               write(ioimp,*)'Ecriture du type des composantes'
            call mpipaC(pChaml.typche(1),nbComp*16,bu,bufPos)
            nbChar=nbChar+nbComp*16
C               write(ioimp,*)'Position du buffer',bufPos
            do iComp=1,nbComp
            pElval = pChaml.ielval(iComp)
C                  write(ioimp,*) 'pElval',pElval
            if(pElval.ne.0) then
               segact pElval
C                 Ecriture du nombres de valeurs par composantes en
C                 flottant
               nNoElv=pElval.velche(/1)
               nbElv=pElval.velche(/2)
               nNoEli=pElval.ielche(/1)
               nbEli  =pElval.ielche(/2)
               call mpipaI(nNoElv,1,bu,bufPos)
               nbInt=nbInt+1
C               write(ioimp,*)'Position du buffer',bufPos
               call mpipaI(nbElv,1,bu,bufPos)
               nbInt=nbInt+1
               call mpipaI(nNoEli,1,bu,bufPos)
               nbInt=nbInt+1
               call mpipaI(nbEli,1,bu,bufPos)
               nbInt=nbInt+1
C                 Ecriture des valeurs
               if(nNoElv*nbElv.ne.0) then
                  call mpipaR(pElval.velche(1,1),nNoElv*nbElv,bu,bufPos)
                  nbFloa=nbFloa+nNoElv*nbElv
               endif
C                 Ecriture du nombres de valeurs par composantes en
C                 flottant
C                 Ce sont des pointeurs, il faut les convertir
               do iEl=1,nbEli
               do iNo=1,nNoEli
               iPoint=pElval.ielche(iNo,iEl)
               iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
               call mpipaI(iPoPi,1,bu,bufPos)
               nbInt=nbInt+1
               enddo
               enddo
               segdes pElval
            else
C              pElval est nul, on l'indique avec tailles nulles
               nbNoEl = 0
               call mpipaI(nbNoEl,1,bu,bufPos)
               nbInt=nbInt+1
               call mpipaI(nbNoEl,1,bu,bufPos)
               nbInt=nbInt+1
               call mpipaI(nbNoEl,1,bu,bufPos)
               nbInt=nbInt+1
               call mpipaI(nbNoEl,1,bu,bufPos)
               nbInt=nbInt+1
            endif
            enddo
            segdes pChaml
         else
C              pChaml est nul, on l'indique avec un nombre de comp nul
            nbComp = 0
            call mpipaI(nbComp,1,bu,bufPos)
            nbInt=nbInt+1
         endif
         enddo
         segdes pChelm
         else
            write(ioimp,*) 'Erreur: pointeur vers un objet CHELM nul'
            call erreur(5)
         endif
C      write(ioimp,*) 'Sortie de CPACHM'
         end
 
 
 
 
 
 

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