C CV2MCB    SOURCE    GOUNAND   24/11/06    21:15:08     12073          
      SUBROUTINE CV2MCB(CGEOMQ,TABVDC,TABMAT,
     $     MYFALS,LCHAM,
     $     MATLSB,CHPLSB,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CV2MCB
C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
C               représentant un ensemble de matrices élémentaires en
C               MATRIK...
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : KEEF   (recherche de l'élément fini)
C APPELES (E/S)    : ECROBJ, PRLIST (écriture entier, objet,
C                    impression)
C APPELE PAR       : PRLSB2
C***********************************************************************
C ENTREES            :
C ENTREES/SORTIES    : -
C SORTIES            :
C TRAVAIL            : * MYMEL (type MELEME) : maillage élémentaire.
C                      * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB
C                        sur le maillage élémentaire.
C                        Structure (cf.include SMCHAEL) :
C                        (nb. ddl dual, nb. ddl primal,
C                         nb. comp. duales, nb. comp. primales,
C                         1, nb. éléments)
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 22/07/09, version initiale
C HISTORIQUE : v1, 22/07/09, création
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 SMLMOTS
      POINTEUR MYLMOT.MLMOTS
      POINTEUR NCVARP.MLMOTS
      POINTEUR NCVARD.MLMOTS
-INC SMELEME
      POINTEUR CGEOMQ.MELEME
-INC SMMATRIK
      POINTEUR MATLSB.MATRIK
      POINTEUR MATTMP.MATRIK
      POINTEUR MATTM2.MATRIK
-INC SMCHPOI
*      POINTEUR CHPLSB.MCHPOI
*      POINTEUR CHPTMP.MCHPOI
*      POINTEUR CHPTM2.MCHPOI
      INTEGER CHPLSB,CHPTMP,CHPTM2
*
* Includes persos
*
-INC TNLIN
*-INC SMCHAEL
      POINTEUR MYMCHA.MCHAEL
*-INC SFALRF
      POINTEUR MYFALS.FALRFS
*-INC SMTNLIN
      INTEGER NUMVPR,NUMVDU
*
      CHARACTER*4 MDISCP,MDISCD,MYDISC
      INTEGER IMPR,IRET
*
      LOGICAL MVVPR,MVVDU
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mcb'
*      WRITE(IOIMP,*) '<'
      MATLSB=0
      CHPLSB=0
      MATTMP=0
      CHPTMP=0
      SEGACT TABVDC
      SEGACT TABMAT
*      SEGPRT,TABMAT
      NUMVPR=TABMAT.VMAT(/2)
      NUMVDU=TABMAT.VMAT(/1)
      DO IVARPR=1,NUMVPR
         DO IVARDU=1,NUMVDU
            IJVARP=TABVDC.VVARPR(IVARPR)
            IJVARD=TABVDC.VVARDU(IVARDU)
            MVVPR=(TABVDC.MVD(IJVARP).NE.0)
            MVVDU=(TABVDC.MVD(IJVARD).NE.0)
            IKVARP=TABVDC.DJSVD(IJVARP)
            MDISCP=TABVDC.DISVD(IKVARP)
            NCVARP=TABVDC.NOMVD(IJVARP)
            IKVARD=TABVDC.DJSVD(IJVARD)
            MDISCD=TABVDC.DISVD(IKVARD)
            NCVARD=TABVDC.NOMVD(IJVARD)
            MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
            IF (MYMCHA.NE.0) THEN
               IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN
* In cv2ma9 : SEGINI MATTMP
                  CALL CV2MAB(CGEOMQ,MDISCP,NCVARP,MDISCD,NCVARD,
     $                 MYMCHA,
     $                 MYFALS,
     $                 MATTMP,
     $                 IMPR,IRET)
                  IF (IRET.NE.0) GOTO 9999
               ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN
                  MYDISC=MDISCP
                  MYLMOT=NCVARP
                  IF (LCHAM.EQ.1) THEN
                     CALL CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
     $                    MYFALS,
     $                    CHPTMP,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                  ELSE
                     CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
     $                    MYFALS,
     $                    CHPTMP,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                  ENDIF
               ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
                  MYDISC=MDISCD
                  MYLMOT=NCVARD
                  IF (LCHAM.EQ.1) THEN
                     CALL CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
     $                    MYFALS,
     $                    CHPTMP,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                  ELSE
                     CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
     $                    MYFALS,
     $                    CHPTMP,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                  ENDIF
               ELSEIF (MVVPR.AND.MVVDU) THEN
                  MYDISC='CSTE'
                  JGN=4
                  JGM=1
                  SEGINI,MYLMOT
*               MYLMOT.MOTS(1)='RES2'
                  MYLMOT.MOTS(1)='SCAL'
* In CV2CP9 : SEGINI CHPTMP
                  IF (LCHAM.EQ.1) THEN
                     CALL CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
     $                    MYFALS,
     $                    CHPTMP,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                  ELSE
                     CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
     $                    MYFALS,
     $                    CHPTMP,
     $                    IMPR,IRET)
                     IF (IRET.NE.0) GOTO 9999
                  ENDIF
                  SEGSUP,MYLMOT
               ENDIF
               IF (CHPTMP.NE.0) THEN
                  IF (CHPLSB.EQ.0) THEN
                     CHPLSB=CHPTMP
                     CHPTMP=0
                  ELSE
                     IF (LCHAM.EQ.1) THEN
                        CALL ADCHEL(CHPLSB,CHPTMP,CHPTM2,1)
                     ELSE
* In ADCHPO : SEGINI CHPTM2
                        CALL ADCHPO(CHPLSB,CHPTMP,CHPTM2,1.D0,1.D0)
                     ENDIF
                     IF (CHPTM2.EQ.0) THEN
                        WRITE(IOIMP,*)
     $                       'Pas pu faire le ET des chpoints...'
                        GOTO 9999
                     ENDIF
                     IF (LCHAM.EQ.1) THEN
                        CALL DTCHAM(CHPLSB)
                        CALL DTCHAM(CHPTMP)
                     ELSE
* In DTCHPO : SEGSUP CHPLSB
                        CALL DTCHPO(CHPLSB)
* In DTCHPO : SEGSUP CHPTMP
                        CALL DTCHPO(CHPTMP)
                     ENDIF
                     CHPLSB=CHPTM2
                     CHPTMP=0
                  ENDIF
               ENDIF
               IF (MATTMP.NE.0) THEN
                  IF (MATLSB.EQ.0) THEN
                     MATLSB=MATTMP
                     MATTMP=0
                  ELSE
* In FUSMTK : SEGINI MATTM2
                     CALL FUSMTK(MATLSB,MATTMP,MATTM2)
                     IF (MATTM2.EQ.0) THEN
                        WRITE(IOIMP,*)
     $                       'Pas pu faire le ET des matriks...'
                        GOTO 9999
                     ENDIF
                     SEGSUP MATLSB
                     SEGSUP MATTMP
                     MATLSB=MATTM2
                     MATTMP=0
                  ENDIF
               ENDIF
            ENDIF
         ENDDO
      ENDDO
      SEGDES TABMAT
      SEGDES TABVDC
*      WRITE(IOIMP,*) '>'
      IF (IMPR.GT.3) THEN
         IF (MATLSB.NE.0) THEN
            CALL ECROBJ('MATRIK',MATLSB)
            CALL PRLIST
         ENDIF
         IF (CHPLSB.NE.0) THEN
            IF (LCHAM.EQ.1) THEN
               CALL ECROBJ('MCHAML  ',CHPLSB)
            ELSE
               CALL ECROBJ('CHPOINT ',CHPLSB)
            ENDIF
            CALL PRLIST
         ENDIF
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine cv2mcb'
      RETURN
*
* End of subroutine CV2MCB
*
      END
 
