Sources Esope | Cast3M

cp2tra
C CP2TRA    SOURCE    CB215821  20/11/25    13:22:48     10792          
      SUBROUTINE CP2TRA(MYCHPO,
     $     MYMTRA,LVIDE,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CP2TRA
C DESCRIPTION : Transformation d'un chpoint MYCHPO
C               en un objet MTRAV MYMTRA plus commode
C               LVIDE est vrai, si le chpoint était vide
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 APPELES          :
C APPELES (E/S)    :
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       : CP2CV6
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 26/09/2002, version initiale
C HISTORIQUE : v1, 26/09/2002, 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 PPARAM
-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
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tra.eso'
      LVIDE=.TRUE.
*
* Construction de la liste des composantes et de la liste des
* melemes du champoint
*
      JGN=LOCOMP
      JGM=0
      IGM=0
      SEGINI,LISCOM
      NBMEL=0
      SEGINI,GPMELS
*
      SEGACT MYCHPO
      NSOUPO=MYCHPO.IPCHP(/1)
      DO ISOUPO=1,NSOUPO
         MYMSOU=MYCHPO.IPCHP(ISOUPO)
         SEGACT MYMSOU
         NC=MYMSOU.NOCOMP(/2)
         JGM=JGM+NC
         SEGADJ,LISCOM
         DO IC=1,NC
            IGM=IGM+1
            LISCOM.MOTS(IGM)=MYMSOU.NOCOMP(IC)
         ENDDO
         GPMELS.LISMEL(**)=MYMSOU.IGEOC
         SEGDES MYMSOU
      ENDDO
      SEGDES MYCHPO
*
* Suppression des doublons dans la liste des composantes
* et création du maillage total des points supports
*
      CALL CUNIQ(LISCOM.MOTS,JGN,JGM,
     $     LISCOM.MOTS,JGM2,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      JGM=JGM2
      SEGADJ,LISCOM
* In MLUNIQ : SEGINI MELTOT
      CALL MLUNIQ(GPMELS,MELTOT,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGSUP GPMELS
*
* 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
      SEGSUP LISCOM
      DO INNOE=1,NNNOE
         MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE)
      ENDDO
*     SEGDES MELTOT
      SEGSUP MELTOT
*
* Remplissage de l'objet MTRAV
*
*  Création du segment de répérage dans IGEO
      NTOGPO=nbpts
      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=NNIN
         SEGINI KRINCO
         CALL CREPER(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)
            DO I=1,N
               IGLOB=MYMEL.NUM(1,I)
               INNOE=KRIGEO.LECT(IGLOB)
               IF (INNOE.EQ.0) THEN
                  WRITE(IOIMP,*) 'Erreur de programmation'
                  GOTO 9999
               ENDIF
               LVIDE=.FALSE.
               MYMTRA.IBIN(ININ,INNOE)=1
               MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC)
            ENDDO
         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 cp2tra'
      RETURN
*
* End of subroutine CP2TRA
*
      END