C CP2TR2    SOURCE    GOUNAND   09/09/03    21:15:02     6481           
      SUBROUTINE CP2TR2(LISCOM,MELTOT,MYCHPO,
     $     MYMTRA,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CP2TR2
C DESCRIPTION : Transformation d'un chpoint MYCHPO
C               en un objet MTRAV MYMTRA plus commode
C               LISCOM et MELEME sont les composantes et points 
C               qui nous intéressent.
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 11/04/2008, version initiale
C HISTORIQUE : v1, 11/04/2008, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC CCOPTIO
-INC SMCOORD
*
-INC SMCHPOI
      POINTEUR MYCHPO.MCHPOI
      POINTEUR MYMSOU.MSOUPO
      POINTEUR MYMPOV.MPOVAL
      INTEGER N,NC
-INC TMTRAV
      POINTEUR MYMTRA.MTRAV
      INTEGER NNIN,NNNOE
-INC SMLMOTS
      POINTEUR LISCOM.MLMOTS
      INTEGER JGN,JGM
-INC SMELEME
      POINTEUR MYMEL.MELEME
      POINTEUR MELTOT.MELEME
-INC SMLENTI      
      POINTEUR KRINCO.MLENTI
      POINTEUR KRIGEO.MLENTI
      INTEGER JG
*     
* Includes persos
*     
* Liste de MELEME
      INTEGER NBMEL
      SEGMENT MELS
      POINTEUR LISMEL(NBMEL).MELEME
      ENDSEGMENT
      POINTEUR GPMELS.MELS
*
      LOGICAL LVIDE
      INTEGER IMPR,IRET
*
      INTEGER I,IC,IGM,JGM2,ININ,INNOE,IGLOB
      INTEGER NTOTPO,NTOGPO
*     
* Executable statements
*
      IMPR=0
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tr2.eso' 
*
      SEGACT LISCOM
      JGN=LISCOM.MOTS(/1)
      JGM=LISCOM.MOTS(/2)
      IF (JGN.NE.4) THEN
         WRITE(IOIMP,*) 'Erreur de programmation'
         GOTO 9999
      ENDIF
*
* Initialisation de l'objet MTRAV
*
      SEGACT MELTOT
      NTOTPO=MELTOT.NUM(/2)
      NNIN=JGM
      NNNOE=NTOTPO
      SEGINI MYMTRA
      DO ININ=1,NNIN
         MYMTRA.INCO(ININ)=LISCOM.MOTS(ININ)
      ENDDO
      SEGDES LISCOM
      DO INNOE=1,NNNOE
         MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE)
      ENDDO
      SEGDES MELTOT
*
* Remplissage de l'objet MTRAV
*
*  Création du segment de répérage dans IGEO
      NTOGPO=XCOOR(/1)/(IDIM+1)
      JG=NTOGPO
      SEGINI,KRIGEO
      CALL RSETEE(MYMTRA.IGEO,NNNOE,
     $     KRIGEO.LECT,NTOGPO,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*  Parcours de l'objet champoint
      SEGACT MYCHPO
      NSOUPO=MYCHPO.IPCHP(/1)
      DO ISOUPO=1,NSOUPO
         MYMSOU=MYCHPO.IPCHP(ISOUPO)
         SEGACT MYMSOU
         NC=MYMSOU.NOCOMP(/2)
*   Création du segment de repérage dans les noms d'inconnues
         JG=NC
         SEGINI KRINCO
         CALL CREPE2(JGN,NC,NNIN,
     $        MYMSOU.NOCOMP,MYMTRA.INCO,
     $        KRINCO.LECT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         MYMEL=MYMSOU.IGEOC
         MYMPOV=MYMSOU.IPOVAL
         SEGACT MYMEL
         SEGACT MYMPOV
         N=MYMPOV.VPOCHA(/1)
         DO IC=1,NC
            ININ=KRINCO.LECT(IC)
            IF (ININ.NE.0) THEN
               DO I=1,N
                  IGLOB=MYMEL.NUM(1,I)
                  INNOE=KRIGEO.LECT(IGLOB)
                  IF (INNOE.NE.0) THEN
                     MYMTRA.IBIN(ININ,INNOE)=1
                     MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC)
                  ENDIF
               ENDDO
            ENDIF   
         ENDDO
         SEGDES MYMPOV
         SEGDES MYMEL
         SEGSUP KRINCO
         SEGDES MYMSOU
      ENDDO
      SEGSUP KRIGEO
      SEGDES MYCHPO
      SEGDES MYMTRA
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine cp2tr2'
      RETURN
*
* End of subroutine CP2TR2
*
      END