C CUPCPO SOURCE PV 22/01/18 21:15:03 11267 subroutine cupcpo(bu,bufPos,pChpo) C======================================================================= C COLlaborateur UnPAQuettage Champ par POint C Lecture d'un champ par point dans le buffer d'envoi bu C======================================================================= integer bufPos integer lonBuf integer nat,nbComp,nbNoeu,nSoupo,n,nc integer iSoupo,mofour character*8 typChp character*72 desChp C character*72 soutyp -INC SMCHPOI -INC PPARAM -INC TMCOLAC segment BUFFER character ffer(lonBuf) endsegment pointeur pChpo.MCHPOI pointeur pSoupo.MSOUPO pointeur pPoval.MPOVAL pointeur bu.BUFFER C write(ioimp,*) 'Entre dans CUPCPO' C write(ioimp,*)'Position du buffer',bufPos lonBuf=bu.ffer(/2) C write(ioimp,*)'Taille du buffer',lonBuf call mpiupC(typChp,8, bu,bufPos) C write(ioimp,*)'Type du champ',typChp C write(ioimp,*)'Position du buffer',bufPos call mpiupC(desChp,72, bu,bufPos) C write(ioimp,*)'Description du champ',desChp C write(ioimp,*)'Position du buffer',bufPos call mpiupI(mofour,1, bu,bufPos) C write(ioimp,*)'Ifopoi',mofour C write(ioimp,*)'Position du buffer',bufPos call mpiupI(nSoupo,1, bu,bufPos) C write(ioimp,*)'nsoupo',nsoupo C write(ioimp,*)'Position du buffer',bufPos call mpiupI(nat,1, bu,bufPos) C write(ioimp,*) 'Buff', bufPos,lonBuf C write(ioimp,*)'nat',nat if (pChpo.ne.0) then segact pChpo*mod segadj pChpo else segini pChpo endif pChpo.MTYPOI=typChp pChpo.MOCHDE=desChp pChpo.IFOPOI=mofour if(nat.gt.0) then call mpiupI(pChpo.jattri(1), nat, bu,bufPos) endif C write(ioimp,*)'jattri',(pChpo.jattri(i),i=1,nat) do iSoupo=1,nSoupo C write(ioimp,*) 'Soupo :',iSoupo call mpiupI(nbComp,1, bu,bufPos) C write(ioimp,*)'nbComp',nbComp call mpiupI(nbNoeu,1, bu,bufPos) C write(ioimp,*)'nbNoeu',nbNoeu nc=nbComp segini pSoupo pChpo.ipchp(iSoupo)=pSoupo n=nbNoeu segini pPoval pSoupo.ipoval=pPoval if(nbNoeu.gt.0.and.nbComp.gt.0) then C write(ioimp,*)'Lecture des valeurs' call mpiupR( pPoval.vpocha(1,1),nbNoeu*nbComp, bu,bufPos) endif segdes pPoval C write(ioimp,*) 'iSoupo',iSoupo C write(ioimp,*) 'pSoupo',pSoupo call mpiupI( pSoupo.igeoc,1, bu,bufPos) C write(ioimp,*)'pSoupo.igeoc',pSoupo.igeoc if(nbComp.gt.0)then call mpiupC( pSoupo.nocomp(1),nbComp*4, bu,bufPos) C write(ioimp,*)'Lecture du nom de composante' C SOUTYP=pSoupo.nocomp(1) C write(ioimp,*) 'Nom composante',soutyp C write(ioimp,*)'Position du buffer',bufPos C write(ioimp,*)'Position du buffer',bufPos call mpiupI( pSoupo.noharm(1),nbComp, bu,bufPos) C write(ioimp,*)'Lecture du numero des harmoniques', C & (pSoupo.noharm(i),i=1,nbComp) C write(ioimp,*)'Position du buffer',bufPos endif segdes pSoupo enddo segdes pChpo C write(ioimp,*) 'Sortie de CUPCPO' end