Télécharger la plaquette Cast3M


fr en

Télécharger cuprig.eso

Retour à la liste

Numérotation des lignes : 

cuprig

  1. C CUPRIG    SOURCE    PV        22/01/18    21:15:03     11267          
  2.       subroutine cuprig(bu,bufPos,pRigi)
  3. C=======================================================================
  4. C     COLlaborateur UnPAQuettage RIGidite
  5. C     Lecture de la rigidite pRigi dans le buffer d'envoi bu
  6. C=======================================================================
  7.       integer bufPos
  8.       integer lonBuf
  9.       integer nrigel,nligrd,nligrp,nelrig
  10.       integer jrigel
  11. -INC SMRIGID
  12.       segment BUFFER
  13.          character ffer(lonBuf)
  14.       endsegment
  15.       pointeur bu.BUFFER
  16.       pointeur pRigi.MRIGID
  17.       pointeur pXmatr.XMATRI
  18.       pointeur pDescr.DESCR
  19.  
  20. C      write(ioimp,*) 'Entre dans CUPRIG'
  21. C      write(ioimp,*) 'Position du buffer',bufPos
  22.       lonBuf=bu.ffer(/2)
  23.  
  24.       call mpiupI(nrigel,1,bu,bufPos)
  25.       if (pRigi.ne.0) then
  26.          segact pRigi*mod
  27.          segadj pRigi
  28.       else
  29.          segini pRigi
  30.       endif
  31.       call mpiupC(pRigi.mtymat,8,bu,bufPos)
  32.       call mpiupI(pRigi.iforig,1,bu,bufPos)
  33.       if(nrigel.gt.0) then
  34.          call mpiupR( pRigi.coerig(1),nrigel,bu,bufPos)
  35.       endif
  36.       do jrigel=1,nrigel
  37.       call mpiupI( pRigi.irigel(1,jrigel) ,2,bu,bufPos)
  38.       call mpiupI( pRigi.irigel(5,jrigel) ,4,bu,bufPos)
  39.       enddo
  40.       do jrigel=1,nrigel
  41.       call mpiupI(nligrd,1,bu,bufPos)
  42.       call mpiupI(nligrp,1,bu,bufPos)
  43.       call mpiupI(nelrig,1,bu,bufPos)
  44.       segini pXmatr
  45.       segini pDescr
  46.       pRigi.irigel(3,jrigel)=pDescr
  47.       pRigi.irigel(4,jrigel)=pXmatr
  48.       call mpiupC( pDescr.lisinc(1),4*nligrp,bu,bufPos)
  49.       call mpiupC( pDescr.lisdua(1),4*nligrd,bu,bufPos)
  50.       call mpiupI( pDescr.noelep(1),nligrp,bu,bufPos)
  51.       call mpiupI( pDescr.noeled(1),nligrd,bu,bufPos)
  52.       call mpiupR( pXmatr.re(1,1,1),nligrd*nligrp*nelrig,bu,bufPos)
  53.       segdes pDescr
  54.       segdes pXmatr
  55.       enddo
  56.       segdes pRigi
  57. C      write(ioimp,*) 'Sortie de CUPRIG'
  58. C      write(ioimp,*) 'Position du buffer',bufPos
  59.       end
  60.  
  61.  
  62.  
  63.  

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