C CPAMOD SOURCE CB215821 24/04/12 21:15:31 11897 subroutine cpamod(pModel,lisNoe,seg2pi,bu,bufPos) C======================================================================= C COLlaborateur PAQuettage MODele C Ajout du model pModel dans le buffer d'envoi bu C Les numeros de noeuds sont "traduit" par la C corespondance lisNoe passe en argument C======================================================================= integer mn3,nlconmo,nfor,nmat,ntyp,nObMod,nbrobl,nbrfac,n1 integer iMod,iInfo,iNomid,iObMod integer bufPos integer lonBuf integer ipoPi,iPoint integer iNoCo,iNoLo integer iObl,iFac integer sePGCD integer nbInt,nbChar integer lconmo -INC PPARAM -INC CCOPTIO -INC SMMODEL -INC TMCOLAC segment BUFFER character ffer(lonBuf) endsegment C La liste de noeud est necessaire pour le noeud de deformation plane C generealisee segment LISNOD integer liste(nNoeud) endsegment pointeur pNomid.NOMID pointeur pModel.MMODEL pointeur modele.IMODEL pointeur lisNoe.LISNOD pointeur bu.BUFFER pointeur seg2pi.ILISSE C write(ioimp,*) 'Entre dans CPAMOD' C write(ioimp,*) 'Position du buffer',bufPos if (pModel.ne.0) then write(ioimp,*) 'Erreur: pointeur vers un objet MODELE nul' call erreur(5) return endif nbInt=0 nbChar=0 segact pModel lonBuf=bu.ffer(/2) C write(ioimp,*) 'taille du buffer',lonBuf sePGCD=seg2pi.npgcd n1 = pModel.kmodel(/1) call mpipaI(n1,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Nombre de modele elem',n1 do iMod=1,n1 modele=pModel.kmodel(iMod) C Pointeur invalide if (modele.le.0) then C write(ioimp,*) 'Pointeur invalide vers le imodel' call erreur(5) endif segact modele mn3=modele.infmod(/1) nlconmo=modele.conmod(/1) nfor = modele.formod(/2) nmat = modele.matmod(/2) ntyp = modele.lnomid(/1) nObMod=modele.ivamod(/1) C write(ioimp,*) 'Taille du modele',mn3, nlconmo, nfor,nmat,nObMod C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(mn3,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(nlconmo,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(nfor,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(nmat,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(ntyp,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(nObMod,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos iPoint=modele.imamod C write(ioimp,*) 'Pointeur: ',iPoint iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD) C write(ioimp,*) 'Numero dans la pile: ',ipoPi call mpipaI(iPoPi,1,bu,bufPos) nbInt=nbInt+1 call mpipaI(modele.nefmod,1,bu,bufPos) nbInt=nbInt+1 call mpipaI(modele.infmod(1),1,bu,bufPos) nbInt=nbInt+1 do iInfo=2,mn3 C write(ioimp,*) 'Info',iInfo,'sur',mn3 iPoint=modele.infmod(iInfo) if(iPoint.gt.0) then C write(ioimp,*) 'Pointeur info: ',iPoint iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD) else C write(ioimp,*) 'Attention, pointeur nul dans le C& modele',pModel iPoPi=iPoint endif C write(ioimp,*) 'Numero dans la pile: ',ipoPi call mpipaI(iPoPi,1,bu,bufPos) nbInt=nbInt+1 enddo call mpipaC(modele.conmod,nlconmo,bu,bufPos) nbChar=nbChar+nlconmo call mpipaC(modele.cmatee,8,bu,bufPos) nbChar=nbChar+8 call mpipaC(modele.formod,16*nfor,bu,bufPos) nbChar=nbChar+16*nmat call mpipaC(modele.matmod,16*nmat,bu,bufPos) nbChar=nbChar+16 C write(ioimp,*) 'Info sur le modele' C write(ioimp,*) 'Position du buffer',bufPos iNoLo=modele.ipdpge C write(ioimp,*) 'iNoLo',iNoLo if(iNoLo.gt.0) then iNoCo= seg2pi.iliseg((iNolo-1)/sePGCD) else iNoCo=0 endif C write(ioimp,*) 'iNoCo',iNoCo call mpipaI(iNoCo,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(modele.iMatee,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(modele.iNatuu,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(modele.iDeriv,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Numero de modele' C write(ioimp,*) 'Position du buffer',bufPos do iNomid=1,ntyp pNomid=modele.lnomid(iNomid) C write(ioimp,*) 'nomid',iNomid,'sur',ntyp if(pNomid.ne.0) then segact pNomid nbrobl=pNomid.lesobl(/2) nbrfac=pNomid.lesfac(/2) call mpipaI(nbrobl,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(nbrfac,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaC(pNomid.lesobl,8*nbrobl,bu,bufPos) nbChar=nbChar+8*nbrobl C write(ioimp,*) 'Position du buffer',bufPos call mpipaC(pNomid.lesfac,8*nbrfac,bu,bufPos) nbChar=nbChar+8*nbrfac C write(ioimp,*) 'Enregistrement du nomid' C write(ioimp,*) 'Position du buffer',bufPos C do iObl=1,nbrobl C write(ioimp,*) 'Obl',iObl,'/',nbrobl,pNomid.lesobl(iObl) C enddo C do iFac=1,nbrFac C write(ioimp,*) 'Fac',iFac,'/',nbrFac,pNomid.lesFac(iFac) C enddo segdes pNomid else C write(ioimp,*) 'Pointeur vers segment nomid invalide' nbrobl=0 nbrfac=0 call mpipaI(nbrobl,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(nbrfac,1,bu,bufPos) nbInt=nbInt+1 C write(ioimp,*) 'Position du buffer',bufPos endif enddo C write(ioimp,*) 'Nomids envoye' C write(ioimp,*) 'Position du buffer',bufPos call mpipaI(modele.infele,16,bu,bufPos) nbInt=nbInt+16 C write(ioimp,*) 'Infele envoye' C write(ioimp,*) 'Position du buffer',bufPos C write(ioimp,*) 'Nombre d objets',nObMod call mpipaC(modele.tymode,8*nObMod,bu,bufPos) nbChar=nbChar+8*nObMod do iObMod=1,nObMod iPoint=modele.iVaMod(iObMod) C write(ioimp,*) 'Pointeur: ',iPoint iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD) C write(ioimp,*) 'Numero dans la pile: ',ipoPi call mpipaI(iPoPi,1,bu,bufPos) nbInt=nbInt+1 enddo segdes modele enddo segdes pModel C write(ioimp,*) 'Sortie de CPAMOD' C write(ioimp,*) 'Position du buffer',bufPos C write(ioimp,*) 'Nb ecrit : entier char',nbInt,nbChar c return end