C CUPRIG SOURCE PV 22/01/18 21:15:03 11267 subroutine cuprig(bu,bufPos,pRigi) C======================================================================= C COLlaborateur UnPAQuettage RIGidite C Lecture de la rigidite pRigi dans le buffer d'envoi bu C======================================================================= integer bufPos integer lonBuf integer nrigel,nligrd,nligrp,nelrig integer jrigel -INC SMRIGID segment BUFFER character ffer(lonBuf) endsegment pointeur bu.BUFFER pointeur pRigi.MRIGID pointeur pXmatr.XMATRI pointeur pDescr.DESCR C write(ioimp,*) 'Entre dans CUPRIG' C write(ioimp,*) 'Position du buffer',bufPos lonBuf=bu.ffer(/2) call mpiupI(nrigel,1,bu,bufPos) if (pRigi.ne.0) then segact pRigi*mod segadj pRigi else segini pRigi endif call mpiupC(pRigi.mtymat,8,bu,bufPos) call mpiupI(pRigi.iforig,1,bu,bufPos) if(nrigel.gt.0) then call mpiupR( pRigi.coerig(1),nrigel,bu,bufPos) endif do jrigel=1,nrigel call mpiupI( pRigi.irigel(1,jrigel) ,2,bu,bufPos) call mpiupI( pRigi.irigel(5,jrigel) ,4,bu,bufPos) enddo do jrigel=1,nrigel call mpiupI(nligrd,1,bu,bufPos) call mpiupI(nligrp,1,bu,bufPos) call mpiupI(nelrig,1,bu,bufPos) segini pXmatr segini pDescr pRigi.irigel(3,jrigel)=pDescr pRigi.irigel(4,jrigel)=pXmatr call mpiupC( pDescr.lisinc(1),4*nligrp,bu,bufPos) call mpiupC( pDescr.lisdua(1),4*nligrd,bu,bufPos) call mpiupI( pDescr.noelep(1),nligrp,bu,bufPos) call mpiupI( pDescr.noeled(1),nligrd,bu,bufPos) call mpiupR( pXmatr.re(1,1,1),nligrd*nligrp*nelrig,bu,bufPos) segdes pDescr segdes pXmatr enddo segdes pRigi C write(ioimp,*) 'Sortie de CUPRIG' C write(ioimp,*) 'Position du buffer',bufPos end