C DEFCAR    SOURCE    OF166741  25/02/21    21:15:47     12166          
      SUBROUTINE DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, WRK1)

********************************************************
*   ENTREES
********************************************************
*
*  NCARR   : nombre de composantes des caractéristiques géométriques
*  ICARA   : dimension de XCAR
*  IB: numéro de l'élément
*  IGAU    : numéro du point de Gauss
*  MFR     : formulation de l'élément
*  MELE    : numéro de l'element fini
*  IVACAR  : pointeur sur un segment mptval de caracteristiques geometrique
*
*******************************************************
*   SORTIES
*******************************************************
*
*  XCAR(ICARA) : caractéristiques géométriques (WRK1)
*
*******************************************************

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO

-INC SMCHAML
-INC SMCOORD

-INC TMPTVAL

      SEGMENT WRK1
        REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
        REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
        REAL*8 DEFP(NSTRS),XCAR(ICARA)
      ENDSEGMENT

      SEGMENT WRKTRA
        REAL*8 TTRAV(NTTRAV)
      ENDSEGMENT

      IF (IVACAR.EQ.0) RETURN

      MPTVAL=IVACAR
      ICARA=XCAR(/1)
*
* cas des tuyaux
*
      IF(MFR.EQ.13)THEN
         DO 2106 IC=1,5
            MELVAL=IVAL(IC)
            IF(MELVAL.NE.0)THEN
               IBMN=MIN(IB,VELCHE(/2))
               IGMN=MIN(IGAU,VELCHE(/1))
               XCAR(IC)=VELCHE(IGMN,IBMN)
            ELSE
               XCAR(IC)=0.D0
            ENDIF
2106      continue
         DO 2107 IC=6,NCARR
            MELVAL=IVAL(IC)
            IF(MELVAL.NE.0)THEN
               IBMN=MIN(IB,VELCHE(/2))
               IGMN=MIN(IGAU,VELCHE(/1))
               XCAR(IC)=VELCHE(IGMN,IBMN)
            ELSE
               XCAR(IC)=-1.D0
            ENDIF
2107      continue
C
C Poutre 3D
C
      ELSE IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
         DO 1107 IC=1,NCARR
            MELVAL=IVAL(IC)
            IF(MELVAL.NE.0)THEN
               IBMN=MIN(IB,VELCHE(/2))
               IGMN=MIN(IGAU,VELCHE(/1))
               XCAR(IC)=VELCHE(IGMN,IBMN)
            ELSE
               XCAR(IC)=0.D0
            ENDIF
1107      continue
C  distinction entre poutre bernouilli et poutre timo en ce qui
C  concerne le defaut pour les sections reduites de l'effort tranchant
         IF(MFR.EQ.7.AND.MELE.EQ.84)THEN
           SD=XCAR(4)
           SREDY=XCAR(5)
           SREDZ=XCAR(6)
           IF(SREDY.EQ.0) XCAR(5)=SD
           IF(SREDZ.EQ.0) XCAR(6)=SD
          ENDIF
C
C Poutre 2D
C
         ELSEIF(IDIM.EQ.2)THEN
          DO 1106 IC=1,NCARR
            MELVAL=IVAL(IC)
            IF(MELVAL.NE.0)THEN
               IBMN=MIN(IB,VELCHE(/2))
               IGMN=MIN(IGAU,VELCHE(/1))
               XCAR(IC)=VELCHE(IGMN,IBMN)
             ELSE
*              cas des coques minces : défaut de alfah
               IF(IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
                   XCAR(IC)=0.66666666666666D0
               ELSE
                   XCAR(IC)=0.D0
               ENDIF
            ENDIF
1106      continue
C  distinction entre poutre bernouilli et poutre timo en ce qui
C  concerne le defaut pour les sections reduites de l'effort tranchant
           SD=XCAR(1)
           if (ncarr.ge.3) then
           SREDY=XCAR(3)
           IF(SREDY.EQ.0) XCAR(3)=SD
           endif
C
      ELSE
         DO 1110 IC=1,ICARA
            MELVAL=IVAL(IC)
            IF(MELVAL.NE.0)THEN
               IBMN=MIN(IB,VELCHE(/2))
               IGMN=MIN(IGAU,VELCHE(/1))
               XCAR(IC)=VELCHE(IGMN,IBMN)
            ELSE
*              cas des coques minces : défaut de alfah
               IF (IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
                  XCAR(IC)=0.66666666666666D0
               ELSE
                  XCAR(IC)=0.D0
               ENDIF
            ENDIF
1110      continue
      ENDIF
*
*    rearrangement du tableau xcar pour qu'on ait le meme ordre
*    que l'ancien  chamelem
*
      IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
            VX=XCAR(ICARA-5)
            VY=XCAR(ICARA-4)
            VZ=XCAR(ICARA-3)
            XCAR(ICARA-5)=XCAR(ICARA-2)
            XCAR(ICARA-4)=XCAR(ICARA-1)
            XCAR(ICARA-3)=XCAR(ICARA)
            XCAR(ICARA-2)=VX
            XCAR(ICARA-1)=VY
            XCAR(ICARA)=VZ
*
      ELSE IF(MFR.EQ.13)THEN
         NTTRAV = 7
         SEGINI WRKTRA
         DO 1111 IC=4,10
            TTRAV(IC-3)=XCAR(IC)
1111        continue
         IF(IDIM.EQ.2)THEN
            XCAR(4)=XCAR(ICARA-1)
            XCAR(5)=XCAR(ICARA)
            DO 1112 IC=1,NTTRAV
               XCAR(IC+5)=TTRAV(IC)
1112        continue
         ELSE IF(IDIM.EQ.3)THEN
            XCAR(4)=XCAR(ICARA-2)
            XCAR(5)=XCAR(ICARA-1)
            XCAR(6)=XCAR(ICARA)
            DO 1113 IC=1,NTTRAV
               XCAR(IC+6)=TTRAV(IC)
1113        continue
         ENDIF
         SEGSUP WRKTRA
      ENDIF

      RETURN
      END