Télécharger la plaquette Cast3M


fr en

Télécharger cpacpo.eso

Retour à la liste

Numérotation des lignes : 

cpacpo

  1. C CPACPO    SOURCE    PV        22/01/18    21:15:03     11267          
  2.       subroutine cpacpo(pChpo,seg2pi,bu,bufPos)
  3. C=======================================================================
  4. C     COLlaborateur PAQuettage CHamp par POint
  5. C     Ajout du chpo pChpo dans le buffer d'envoi bu
  6. C=======================================================================
  7.       integer bufPos
  8.       integer lonBuf
  9.       integer nat,nbComp,nbNoeu,nSoupo
  10.       integer iSoupo
  11.       integer ipoPi,iPoint
  12.       integer sePGCD
  13. C      CHARACTER*72 SOUTYP
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMCHPOI
  18. -INC TMCOLAC
  19.       segment BUFFER
  20.       character ffer(lonBuf)
  21.       endsegment
  22.       pointeur pChpo.MCHPOI
  23.       pointeur pSoupo.MSOUPO
  24.       pointeur pPoval.MPOVAL
  25.       pointeur bu.BUFFER
  26.       pointeur seg2pi.ILISSE
  27.  
  28. C      write(ioimp,*) 'Entre dans CPACPO'
  29. C      write(ioimp,*)'Position du buffer',bufPos
  30.       if (pChpo.ne.0) then
  31.          segact pChpo
  32. C         SOUTYP=pChpo.MTYPOI
  33.          lonBuf=bu.ffer(/2)
  34.          sePGCD=seg2pi.npgcd
  35. C         write(ioimp,*)'Taille du buffer',lonBuf
  36.          nat =pChpo.jattri(/1)
  37. C Ecriture du type
  38. C         write(ioimp,*)' Ecriture du type'
  39.          call mpipaC(pChpo.mtypoi,8,bu,bufPos)
  40. C         write(ioimp,*)'Position du buffer',bufPos
  41. C         SOUTYP=pChpo.mochde
  42. C Ecriture de la description
  43. C         write(ioimp,*) 'Ecriture de la description'
  44.          call mpipaC(pChpo.mochde,72,bu,bufPos)
  45. C         write(ioimp,*)'Position du buffer',bufPos
  46. C Ecriture sur fourrier
  47. C         write(ioimp,*)'Ecriture de IFOPOI',pChpo.ifopoi
  48.          call mpipaI(pChpo.ifopoi,1,bu,bufPos)
  49. C         write(ioimp,*)'Position du buffer',bufPos
  50. C Ecriture des sous po
  51.          nSoupo=pChpo.ipchp(/1)
  52. C Ecriture du nombre de soupo
  53. C         write(ioimp,*)'Ecriture du nombre de soupo',nSoupo
  54.          call mpipaI(nSoupo,1,bu,bufPos)
  55. C         write(ioimp,*)'Position du buffer',bufPos
  56. C Ecriture du nombre de nature
  57. C         write(ioimp,*)'Ecriture du nombre de nature',nat
  58.          call mpipaI(nat,1,bu,bufPos)
  59. C Ecriture de la nature
  60. c         write(ioimp,*)'Ecriture de la nature'
  61.          if(nat.gt.0) then
  62.             call mpipaI(pChpo.jattri(1),nat,bu,bufPos)
  63.          endif
  64.          do iSoupo=1,nSoupo
  65. C            write(ioimp,*) 'Soupo :',iSoupo
  66.          pSoupo=pChpo.ipchp(iSoupo)
  67.          if(pSoupo.ne.0) then
  68.             segact pSoupo
  69. C              Ecriture du nombre de composantes
  70.             nbComp = pSoupo.noharm(/1)
  71.             pPoval = pSoupo.ipoval
  72.             if(pPoval.ne.0) then
  73.                segact pPoval
  74.                nbNoeu = pPoval.vpocha(/1)
  75.             else
  76.                nbNoeu = 0
  77.             endif
  78. C               write(ioimp,*)'Ecriture du nombre de composantes',nbComp
  79.             call mpipaI(nbComp,1,bu,bufPos)
  80. C               write(ioimp,*)'Ecriture du nombre de noeud',nbNoeu
  81.             call mpipaI(nbNoeu,1,bu,bufPos)
  82.             if(nbNoeu.gt.0.and.nbComp.gt.0) then
  83. C                 Ecriture des valeurs
  84. C                 write(ioimp,*)'Ecriture des valeurs'
  85.                call mpipaR(pPoval.vpocha(1,1),nbNoeu*nbComp,bu,bufPos)
  86.                segdes pPoval
  87.             endif
  88. C             Ecriture du maillage support
  89. C               write(ioimp,*) 'Maillage support'
  90.             iPoint=pSoupo.igeoc
  91.             if(iPoint.ne.0) then
  92.                iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  93.             else
  94.                iPoPi = 0
  95.             endif
  96. C               write(ioimp,*) 'Pointeur vers maillage et position dans la
  97. C     &      pile',iPoint, iPopi
  98.             call mpipaI(iPoPi,1,bu,bufPos)
  99. C              Ecriture des noms des composantes
  100. C               write(ioimp,*)'Ecriture du nom des composantes'
  101.             if(nbComp.gt.0) then
  102.                call mpipaC(pSoupo.nocomp(1),nbComp*4,bu,bufPos)
  103. C                 SOUTYP=pSoupo.nocomp(1)
  104. C                 write(ioimp,*) 'Nom composante',soutyp
  105. C                 write(ioimp,*)'Position du buffer',bufPos
  106.  
  107. C                 Ecriture des noms des constituants
  108. C                 write(ioimp,*)'Position du buffer',bufPos
  109. C                 Ecriture du numero des harmoniques
  110. C                 write(ioimp,*)'Ecriture du numero des harmoniques',
  111. C                 & (pSoupo.noharm(i),i=1,nbComp)
  112.                call mpipaI(pSoupo.noharm(1),nbComp,bu,bufPos)
  113. C                 write(ioimp,*)'Position du buffer',bufPos
  114.             endif
  115.             segdes pSoupo
  116.          else
  117. C              pSoupo est nul, on l'indique avec un nombre de comp nul
  118. C               ainsi qu'un pointeur vers un maillage nul et un nb de
  119. C               noeud nul
  120.             nbComp = 0
  121. C               write(ioimp,*)'Ecriture du nombre de composantes',nbComp
  122.             call mpipaI(nbComp,1,bu,bufPos)
  123.             call mpipaI(nbComp,1,bu,bufPos)
  124.             call mpipaI(nbComp,1,bu,bufPos)
  125.          endif
  126.          enddo
  127.          segdes pChpo
  128.       else
  129.          write(ioimp,*) 'Erreur: pointeur vers un objet CHPO nul'
  130.          call erreur(5)
  131.       endif
  132. C      write(ioimp,*) 'Sortie de CPACPO'
  133.       end
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  

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