C CARMAT    SOURCE    OF166741  25/02/21    21:15:27     12166          

C_______________________________________________________________________
C
C  Entrees:
C  ________
C
C    IPMODE   Pointeur sur un IMODEL
C    IPCHE1   Pointeur sur un MCHAML de caracteristiques
C    IPMAIL   Pointeur sur un maillage elementaire
C    MFR      Formulation de l element fini
C    MELE     Numero de l element fini
C    CMATE    Nom du materiau
C    ISUP5    Critere d existence des caracteristiques
C    INFOS    Tableau d infos
C    CONM     Nom du maillage elementaire
C
C  Sorties:
C  ________
C
C     IMAT  = Pointeur sur un tableau de MELVAL de MATERIAU
C     ICAR  = Pointeur sur un tableau de MELVAL de CARACTERISTIQUES
C     NUMAT = Nombre des composantes de materiau
C     NUCAR = Nombre des composantes des caract. geometriques
C     IRET    1 si tout OK 0 sinon
C
C_______________________________________________________________________
C
      SUBROUTINE CARMAT(IPMODE,IPCHE1,IPMAIL,MFR,MELE,CMATE,
     &   ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET)

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

-INC PPARAM
-INC CCOPTIO
-INC CCHAMP
-INC CCGEOME

-INC SMCHAML
-INC SMMODEL

      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT

      CHARACTER*8 CMATE
      CHARACTER*(NCONCH) CONM
      PARAMETER (NINF=3)
      INTEGER INFOS(NINF)
      LOGICAL lsupma

      IRET=1

      IMAT=0
      ICAR=0
      MOCARA=0
      MOMATR=0
      NUMAT=0
      NUCAR=0
C
C     TRAITEMENT DU MODELE
C
      IMODEL=IPMODE
      lsupma=.true.

      IPPORE=0
      IF(MFR.EQ.33) IPPORE= NBNNE(NUMGEO(MELE))

      NBROBL=0
      NBRFAC=0
      NOMID =0

*     TRAITEMENT DES CHAMPS DE MATERIAU

      IF (FORMOD(1).EQ.'MECANIQUE') THEN
        IF (CMATE.EQ.'ISOTROPE') THEN
          IF (MFR.EQ.35) THEN
            NBROBL=2
            SEGINI NOMID
            LESOBL(1)='KS  '
            LESOBL(2)='KN  '
          ELSE IF(MFR.EQ.53)THEN
              NBROBL=1
              SEGINI,NOMID
              LESOBL(1)='KS  '
          ELSE
            NBROBL=2
            SEGINI NOMID
            LESOBL(1)='YOUN'
            LESOBL(2)='NU  '
          ENDIF
        ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
*                 COQUES MINCES
          IF (MFR.EQ.3) THEN
            NBROBL=6
            SEGINI NOMID
            LESOBL(1)='YG1 '
            LESOBL(2)='YG2 '
            LESOBL(3)='NU12'
            LESOBL(4)='G12 '
            LESOBL(5)='V1X '
            LESOBL(6)='V1Y '
*                 COQUES    AVEC CISAILLEMENT TRANSVERSE
          ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN
            NBROBL=8
            SEGINI NOMID
            LESOBL(1)='YG1 '
            LESOBL(2)='YG2 '
            LESOBL(3)='NU12'
            LESOBL(4)='G12 '
            LESOBL(5)='G23 '
            LESOBL(6)='G13 '
            LESOBL(7)='V1X '
            LESOBL(8)='V1Y '
*                 ELEMENTS MASSIFS
          ELSE IF (MFR.EQ.1) THEN
*                    ELEMENTS 3D
            IF(IDIM.EQ.3)THEN
              NBROBL=15
              SEGINI NOMID
              LESOBL(1)='YG1 '
              LESOBL(2)='YG2 '
              LESOBL(3)='YG3 '
              LESOBL(4)='NU12'
              LESOBL(5)='NU23'
              LESOBL(6)='NU13'
              LESOBL(7)='G12 '
              LESOBL(8)='G23 '
              LESOBL(9)='G13 '
              LESOBL(10)='V1X '
              LESOBL(11)='V1Y '
              LESOBL(12)='V1Z '
              LESOBL(13)='V2X '
              LESOBL(14)='V2Y '
              LESOBL(15)='V2Z '
            ELSE IF (IDIM.EQ.2) THEN
              IF(IFOUR.EQ.-2)THEN
*                       CONTRAINTE PLANE
                 NBROBL=6
                 SEGINI NOMID
                 LESOBL(1)='YG1 '
                 LESOBL(2)='YG2 '
                 LESOBL(3)='NU12'
                 LESOBL(4)='G12 '
                 LESOBL(5)='V1X '
                 LESOBL(6)='V1Y '
         ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
*                       DEFORMATION PLANE ,AXISYMETRIE
                 NBROBL=9
                 SEGINI NOMID
                 LESOBL(1)='YG1 '
                 LESOBL(2)='YG2 '
                 LESOBL(3)='YG3 '
                 LESOBL(4)='NU12'
                 LESOBL(5)='NU23'
                 LESOBL(6)='NU13'
                 LESOBL(7)='G12 '
                 LESOBL(8)='V1X '
                 LESOBL(9)='V1Y '
              ELSE IF (IFOUR.EQ.1) THEN
*                 AXISYMETRIE DE FOURIER
                 NBROBL=11
                 SEGINI NOMID
                 LESOBL(1)='YG1 '
                 LESOBL(2)='YG2 '
                 LESOBL(3)='YG3 '
                 LESOBL(4)='NU12'
                 LESOBL(5)='NU23'
                 LESOBL(6)='NU13'
                 LESOBL(7)='G12 '
                 LESOBL(8)='G23 '
                 LESOBL(9)='G13 '
                 LESOBL(10)='V1X '
                 LESOBL(11)='V1Y '
              ENDIF
            ENDIF
          ELSE IF (MFR.EQ.35) THEN
*                 ELEMENTS JOINTS
            IF (IFOUR.EQ.2) THEN
                     NBROBL=5
                     SEGINI NOMID
                     LESOBL(1)='KS1 '
                     LESOBL(2)='KS2 '
                     LESOBL(3)='KN  '
                     LESOBL(4)='V1X '
                     LESOBL(5)='V1Y '
            ENDIF
          ENDIF
        ELSEIF (CMATE.EQ.'ANISOTRO') THEN
               IF(MFR.EQ.1)THEN
*                 ELEMENTS MASSIFS
                  IF(IDIM.EQ.3)THEN
*                    ELEMENTS 3D
                   IF (IFOUR.EQ.2) THEN
                    NBROBL=27
                    SEGINI NOMID
                    LESOBL(1)='D11 '
                    LESOBL(2)='D21 '
                    LESOBL(3)='D22 '
                    LESOBL(4)='D31 '
                    LESOBL(5)='D32 '
                    LESOBL(6)='D33 '
                    LESOBL(7)='D41 '
                    LESOBL(8)='D42 '
                    LESOBL(9)='D43 '
                    LESOBL(10)='D44 '
                    LESOBL(11)='D51 '
                    LESOBL(12)='D52 '
                    LESOBL(13)='D53 '
                    LESOBL(14)='D54 '
                    LESOBL(15)='D55 '
                    LESOBL(16)='D61 '
                    LESOBL(17)='D62 '
                    LESOBL(18)='D63 '
                    LESOBL(19)='D64 '
                    LESOBL(20)='D65 '
                    LESOBL(21)='D66 '
                    LESOBL(22)='V1X '
                    LESOBL(23)='V1Y '
                    LESOBL(24)='V1Z '
                    LESOBL(25)='V2X '
                    LESOBL(26)='V2Y '
                    LESOBL(27)='V2Z '
                   ENDIF
                  ELSE IF (IDIM.EQ.2) THEN
                     IF (IFOUR.EQ.-2) THEN
*                       CONTRAINTE PLANE
                       NBROBL=8
                       SEGINI NOMID
                       LESOBL(1)='D11 '
                       LESOBL(2)='D21 '
                       LESOBL(3)='D22 '
                       LESOBL(4)='D41 '
                       LESOBL(5)='D42 '
                       LESOBL(6)='D44 '
                       LESOBL(7)='V1X '
                       LESOBL(8)='V1Y '
         ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
*                    DEFORMATION PLANE ,AXISYMETRIE
                       NBROBL=12
                       SEGINI NOMID
                       LESOBL(1)='D11 '
                       LESOBL(2)='D21 '
                       LESOBL(3)='D22 '
                       LESOBL(4)='D31 '
                       LESOBL(5)='D32 '
                       LESOBL(6)='D33 '
                       LESOBL(7)='D41 '
                       LESOBL(8)='D42 '
                       LESOBL(9)='D43 '
                       LESOBL(10)='D44 '
                       LESOBL(11)='V1X '
                       LESOBL(12)='V1Y '
                     ELSE IF (IFOUR.EQ.1) THEN
*                       AXISYMETRIE DE FOURIER
                       NBROBL=15
                       SEGINI NOMID
                       LESOBL(1)='D11 '
                       LESOBL(2)='D21 '
                       LESOBL(3)='D22 '
                       LESOBL(4)='D31 '
                       LESOBL(5)='D32 '
                       LESOBL(6)='D33 '
                       LESOBL(7)='D41 '
                       LESOBL(8)='D42 '
                       LESOBL(9)='D43 '
                       LESOBL(10)='D44 '
                       LESOBL(11)='D55 '
                       LESOBL(12)='D65 '
                       LESOBL(13)='D66 '
                       LESOBL(14)='V1X '
                       LESOBL(15)='V1Y '
                     ENDIF
                  ENDIF
               ENDIF
          ELSEIF (CMATE.EQ.'UNIDIREC') THEN
             IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN
              NBROBL=7
              SEGINI NOMID
              LESOBL(1)='YOUN'
              LESOBL(2)='V1X '
              LESOBL(3)='V1Y '
              LESOBL(4)='V1Z '
              LESOBL(5)='V2X '
              LESOBL(6)='V2Y '
              LESOBL(7)='V2Z '
             ELSE
              NBROBL=3
              SEGINI NOMID
              LESOBL(1)='YOUN'
              LESOBL(2)='V1X '
              LESOBL(3)='V1Y '
             ENDIF
         ELSE
            if(lnomid(6).ne.0) then
             nomid=lnomid(6)
             segact nomid
             nbrobl =lesobl(/2)
             nbrfac =lesfac(/2)
             lsupma=.false.
            else
             CALL IDMATR(MFR,IMODEL,nomid,nbrobl,nbrfac)
            endif
        ENDIF
      ELSE
        if(lnomid(6).ne.0) then
          nomid=lnomid(6)
          segact nomid
          nbrobl =lesobl(/2)
          nbrfac =lesfac(/2)
          lsupma = .false.
        else
          CALL IDMATR(MFR,IMODEL,nomid,nbrobl,nbrfac)
        endif
      ENDIF

      NMATR  = NBROBL
      NMATF  = NBRFAC
      NUMAT  = NMATR+NMATF
      MOMATR = NOMID

      IF (MOMATR.NE.0) THEN

        IF (MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN
          NBTYPE=3
          SEGINI NOTYPE
          TYPE(1)='POINTEURMMODEL'
          TYPE(2)='POINTEURMCHAML'
          TYPE(3)='POINTEURLISTREEL'
        ELSE
          NBTYPE=1
          SEGINI NOTYPE
          TYPE(1)='REAL*8'
        ENDIF
        MOTYPE=NOTYPE

        CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IMAT)
        SEGSUP NOTYPE

        IF (IERR.NE.0) GOTO 9990

        IF (ISUP5.EQ.1) THEN
          CALL VALCHE (IMAT,NUMAT,IPMINT,IPPORE,MOMATR,MELE)
        ENDIF

        NOMID = MOMATR
        IF (lsupma) SEGSUP NOMID

      ENDIF

C____________________________________________________________________
C
* TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
C____________________________________________________________________
C
      NBROBL = 0
      NBRFAC = 0
      NOMID  = 0

* EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES

      IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
        NBROBL=1
        NBRFAC=1
        SEGINI NOMID
        LESOBL(1)='EPAI'
        LESFAC(1)='EXCE'

* SECTION POUR LES BARRES

      ELSE IF (MFR.EQ.27) THEN
           NBROBL=1
           SEGINI NOMID
           LESOBL(1)='SECT'

* section, excentrements et orientation pour les barres excentrees
      ELSE IF (MFR.EQ.49) THEN
           NBROBL=6
           SEGINI NOMID
           LESOBL(1)='SECT'
           LESOBL(2)='EXCZ'
           LESOBL(3)='EXCY'
           LESOBL(4)='VX  '
           LESOBL(5)='VY  '
           LESOBL(6)='VZ  '

           NBTYPE=1
           SEGINI NOTYPE
           MOTYPE=NOTYPE
           TYPE(1)='REAL*8'

* CARACTERISTIQUES POUR LES POUTRES

      ELSE IF (MFR.EQ.7 ) THEN
           IF (CMATE.NE.'SECTION') THEN
              IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
               NBRFAC=1
               NBROBL=2
               SEGINI NOMID
               LESOBL(1)= 'SECT'
               LESOBL(2)= 'INRZ'
               LESFAC(1)= 'SECY'
             ELSE
               NBROBL=4
               NBRFAC=2
               SEGINI NOMID
               LESOBL(1)='TORS'
               LESOBL(2)='INRY'
               LESOBL(3)='INRZ'
               LESOBL(4)='SECT'
               LESFAC(1)='SECY'
               LESFAC(2)='SECZ'
             ENDIF
        ELSE
          NBRFAC=3
          SEGINI NOMID
          LESFAC(1)='VX'
          LESFAC(2)='VY'
          LESFAC(3)='VZ'
        ENDIF

* CARACTERISTIQUES POUR LES TUYAUX

      ELSE IF (MFR.EQ.13) THEN
        NBROBL=2
        NBRFAC=8
        SEGINI NOMID
        LESOBL(1)='EPAI'
        LESOBL(2)='RAYO'
        LESFAC(1)='RACO'
        LESFAC(2)='PRES'
        LESFAC(3)='CISA'
        LESFAC(4)='CFFX'
        LESFAC(5)='CFMX'
        LESFAC(6)='CFMY'
        LESFAC(7)='CFMZ'
        LESFAC(8)='CFPR'

* CARACTERISTIQUES POUR LES LINESPRING

      ELSE IF (MFR.EQ.15) THEN
        NBROBL=5
        SEGINI NOMID
        LESOBL(1)='EPAI'
        LESOBL(2)='FISS'
        LESOBL(3)='VX  '
        LESOBL(4)='VY  '
        LESOBL(5)='VZ  '

* CARACTERISTIQUES POUR LES TUYAUX FISSURES

      ELSE IF (MFR.EQ.17) THEN
        NBROBL=9
        SEGINI NOMID
        LESOBL(1)='RAYO'
        LESOBL(2)='EPAI'
        LESOBL(3)='VX  '
        LESOBL(4)='VY  '
        LESOBL(5)='VZ  '
        LESOBL(6)='VXF '
        LESOBL(7)='VYF '
        LESOBL(8)='VZF '
        LESOBL(9)='ANGL'

* CARACTERISTIQUES DES ELEMENTS HOMOGENEISES

      ELSE IF (MFR.EQ.37) THEN
        IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
          NBROBL=5
          SEGINI NOMID
          LESOBL(1)='SCEL'
          LESOBL(2)='SFLU'
          LESOBL(3)='EPS '
          LESOBL(4)='SECT'
          LESOBL(5)='INRZ'
        ELSE
          NBROBL=3
          NBRFAC=2
          SEGINI NOMID
          LESOBL(1)='SCEL'
          LESOBL(2)='SFLU'
          LESOBL(3)='EPS '
          LESFAC(1)='NOF1'
          LESFAC(2)='NOF2'
        ENDIF
      ENDIF

      NCARA  = NBROBL
      NCARF  = NBRFAC
      NUCAR  = NCARA+NCARF
      MOCARA = NOMID

      IF (MOCARA.NE.0)  THEN

        NBTYPE=1
        SEGINI,NOTYPE
        TYPE(1) ='REAL*8'
        IF (CMATE.EQ.'SECTION') TYPE(1)='POINTEURPOINT   '
        MOTYPE=NOTYPE

        CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,ICAR)
        SEGSUP NOTYPE
        IF (IERR.NE.0) GOTO 9990

        IF (ISUP5.EQ.1) THEN
          CALL VALCHE(ICAR,NUCAR,IPMINT,IPPORE,MOCARA,MELE)
        ENDIF

        NOMID = MOCARA
        SEGSUP,NOMID

      ENDIF

      RETURN

 9990 CONTINUE

*     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR

      IRET  =0

      IF (ISUP5.EQ.1) THEN
        CALL DTMVAL(IMAT,3)
        CALL DTMVAL(ICAR,3)
      ELSE
        CALL DTMVAL(IMAT,1)
        CALL DTMVAL(ICAR,1)
      ENDIF

      NOMID=MOCARA
      IF (MOCARA.NE.0) SEGSUP NOMID

      RETURN
      END