Sources Esope | Cast3M

idcara
C IDCARA    SOURCE    MB234859  25/08/04    21:15:12     12339          
*--------------------------------------------------------------------*
*             RECHERCHE DES NOMS DE CARACTERISTIQUES                 *
*--------------------------------------------------------------------*
*                                                                    *
*  ENTREES:                                                          *
*                                                                    *
*    IPMODE    Pointeur sur un MMODEL.KMODEL                         *
*    MFR0      Numero de Formulation                                 *
*      - Sert seulement si different de celui calcule avec IMODEL    *
*                                                                    *
*  SORTIES:                                                          *
*                                                                    *
*     IPNOMC   Pointeur sur les tables de noms de composantes        *
*              obligatoires et facultatives                          *
*     NBROBL   leur nombre  ( =0 si pas trouve )                     *
*     NBRFAC   leur nombre ( =0 si pas trouve )                      *
*                                                                    *
*   Remarque : Voir INOMID ou CCOPTIO pour signification IFOUR       *
*--------------------------------------------------------------------*
C
      SUBROUTINE IDCARA(IPMODE,MFR0,IPNOMC,NBROBL,NBRFAC)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC PPARAM
-INC CCOPTIO
C==DEB= FORMULATION HHO == Include specifique ==========================
-INC CCHHOPA
C==FIN= FORMULATION HHO ================================================
-INC SMMODEL
C
      NBROBL = 0
      NBRFAC = 0
      NOMID  = 0
C
      IMODEL=IPMODE
      NMAT=IMODEL.MATMOD(/2)
      CALL PLACE(MATMOD,NMAT,IIMPE,'IMPEDANCE')
      IF (IIMPE.NE.0) RETURN
C
      IMODEL=IPMODE
      MELE  =IMODEL.NEFMOD
      MFR   =NUMMFR(MELE)
      NOMID =IMODEL.LNOMID(7)
C
C     Ne pas recreer le NOMID si deja present
      IF(NOMID.NE.0.AND.(MFR.EQ.MFR0))THEN
        SEGACT,NOMID
        NBROBL=LESOBL(/2)
        NBRFAC=LESFAC(/2)
        IPNOMC=NOMID
        RETURN
      ENDIF
C
      MFR = MFR0
      MFR2=NUMFOR(IMODEL)
      MFR4=IMODEL.INFELE(13)
*
*     ELEMENTS  CIFL   MACRO ELEMENT CISAILLEMENT FLEXION
*
      IF (MELE.EQ.258)THEN
        IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
          NBROBL=2
          SEGINI NOMID
          LESOBL(1)= 'SECT'
          LESOBL(2)= 'INRZ'
        ENDIF
      ENDIF
C     =================================================================
C     FORMULATION MECANIQUE
C     =================================================================
      IF (MFR2.EQ.2) THEN
C
C       Cas particulier
C       ============================================
        IF (MFR.EQ.1.OR.MFR.EQ.75.OR.IFOUR.LT.-3.OR.IFOUR.GT.2) THEN
C
C         ajout de la densite (rendement) vectorielle du constituant kich
          NBROBL=0
          NBRFAC=10
          SEGINI,NOMID
          LESFAC(1) = 'REND'
          LESFAC(2) = 'W1X '
          LESFAC(3) = 'W1Y '
          LESFAC(4) = 'W1Z '
          LESFAC(5) = 'W2X '
          LESFAC(6) = 'W2Y '
          LESFAC(7) = 'W2Z '
          LESFAC(8) = 'REN1'
          LESFAC(9) = 'REN2'
          LESFAC(10)= 'REN3'
C
C       Elements COQUE MINCE CISAILLEMENT TRANSVERSE
C       ============================================
        ELSE IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
          NBROBL=1
          NBRFAC=2
          SEGINI NOMID
          LESOBL(1)='EPAI'
          LESFAC(1)='CALF'
          LESFAC(2)='EXCE'
C
C       Elements COQUE EPAISSE
C       ======================
        ELSE IF (MFR.EQ.5) THEN
          NBROBL=1
          NBRFAC=1
          SEGINI NOMID
          LESOBL(1)='EPAI'
          LESFAC(1)='EXCE'
C
C       Elements POUTRE
C       ===============
        ELSE IF (MFR.EQ.7) THEN
          IF (IFOUR.EQ.2) THEN
            NBRFAC=10
            NBROBL=4
            SEGINI NOMID
            LESOBL(1)= 'TORS'
            LESOBL(2)= 'INRY'
            LESOBL(3)= 'INRZ'
            LESOBL(4)= 'SECT'
            LESFAC(1)= 'SECY'
            LESFAC(2)= 'SECZ'
            LESFAC(3)= 'DX  '
            LESFAC(4)= 'DY  '
            LESFAC(5)= 'DZ  '
            LESFAC(6)= 'OMEG'
            LESFAC(7)= 'VECT'
            LESFAC(8)= 'VX  '
            LESFAC(9)= 'VY  '
            LESFAC(10)= 'VZ  '
          ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
            NBRFAC=2
            NBROBL=2
            SEGINI NOMID
            LESOBL(1)= 'SECT'
            LESOBL(2)= 'INRZ'
            LESFAC(1)= 'SECY'
            LESFAC(2)= 'DY  '
          ENDIF
C
C       Elements LIAISON
C       ================
        ELSE IF (MFR.EQ.51) THEN
          NBROBL=9
          SEGINI NOMID
          LESOBL(1)='RLUX'
          LESOBL(2)='RLUY'
          LESOBL(3)='RLUZ'
          LESOBL(4)='RLRX'
          LESOBL(5)='RLRY'
          LESOBL(6)='RLRZ'
          LESOBL(7)='VX  '
          LESOBL(8)='VY  '
          LESOBL(9)='VZ  '
C
C       Elements BARRE EXCENTREE
C       ========================
        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  '
C
C       Elements TUYAU
C       ==============
        ELSE IF (MFR.EQ.13) THEN
          IF (IFOUR.EQ.2) THEN
            NBROBL=2
            NBRFAC=13 
            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'
            LESFAC(9)= 'OMEG'
            LESFAC(10)='VECT'
            LESFAC(11)='VX  '
            LESFAC(12)='VY  '
            LESFAC(13)='VZ  '
          ENDIF
C
C       Elements TUYO
C       =============
        ELSE IF (MFR.EQ.39) THEN
           IF (IFOUR.EQ.2) THEN
              NBROBL=2
              NBRFAC=6
              SEGINI NOMID
              LESOBL(1)='EPAI'
              LESOBL(2)='RAYO'
              LESFAC(1)='RACO'
              LESFAC(2)='PRES'
              LESFAC(3)='VECT'
              LESFAC(4)='VX  '
              LESFAC(5)='VY  '
              LESFAC(6)='VZ  '
           ENDIF
C
C       Elements LINESPRING
C       ===================
        ELSE IF (MFR.EQ.15) THEN
           IF (IFOUR.EQ.2) THEN
              NBROBL=5
              SEGINI NOMID
              LESOBL(1)='EPAI'
              LESOBL(2)='FISS'
              LESOBL(3)='VX  '
              LESOBL(4)='VY  '
              LESOBL(5)='VZ  '
           ENDIF
C
C       Elements TUYAU FISSURE
C       ===========================
        ELSE IF (MFR.EQ.17) THEN
          IF (IFOUR.EQ.2) 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'
          ENDIF
C
C       Elements BARRE/COS2
C       ===================
        ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
          IF (MFR4.NE.26.AND.MFR4.NE.28) THEN
            NBROBL=1
            SEGINI NOMID
            LESOBL(1)='SECT'
          ENDIF
C
C       Elements HOMOGENEISE
C       =====================
        ELSE IF (MFR.EQ.37) THEN
          IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) 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
C
C       Elements SECTION
C       ================
        ELSE IF (MFR.EQ.47) THEN
          IF (IFOUR.EQ.2) THEN
            NBROBL=2
            SEGINI NOMID
            LESOBL(1)='ALPY'
            LESOBL(2)='ALPZ'
          ELSE
            NBROBL=1
            NBRFAC=0
            SEGINI NOMID
            LESOBL(1)='ALPY'
          ENDIF
C
C         CARACTERISTIQUE SUPPLEMENTAIRE POUR LE SEGS
          IF (MELE.EQ.166) THEN
            NBROBL=NBROBL+1
            SEGADJ,NOMID
            LESOBL(NBROBL)='LARG'
C         CARACTERISTIQUE SUPPLEMENTAIRE POUR LE POJS
          ELSE IF (MELE.EQ.167) THEN
            NBROBL=NBROBL+1
            SEGADJ,NOMID
            LESOBL(NBROBL)='SECT'
          ENDIF
C
C       Elements JOINTS GENERALISE
C       ==========================
        ELSE IF (MFR.EQ.55) THEN
          NBROBL=0
          NBRFAC=1
          SEGINI NOMID
          LESFAC(1)='EPAI'
        ENDIF
C     =================================================================
C     FORMULATION LIQUIDE/MECANIQUE+LIQUIDE
C     =================================================================
      ELSE IF ((MFR2.EQ.11) .OR. (MFR2.EQ.44)) THEN
C
C       Elements LIQUIDE 
C       ================
        IF (MFR.EQ.11.OR.MFR.EQ.19.OR.MFR.EQ.21) THEN
          IF (IFOUR.EQ.2) THEN
            NBROBL=0
            NBRFAC=3
            SEGINI NOMID
            LESFAC(1)='VX  '
            LESFAC(2)='VY  '
            LESFAC(3)='VZ  '
          ELSE
            NBROBL=0
            NBRFAC=2
            SEGINI NOMID
            LESFAC(1)='VX  '
            LESFAC(2)='VY  '
          ENDIF
C
C       Elements TUYAU ACOUSTIQUE PUR
C       =============================
        ELSE IF (MFR.EQ.41) THEN
          NBROBL=1
          NBRFAC=1
          SEGINI NOMID
          LESOBL(1)='RAYO'
 
C
C       Element de RACCORD LIQUIDE TUYAU
C       ================================
        ELSE IF (MFR.EQ.43) THEN
          NBROBL=1
          NBRFAC=5
          SEGINI NOMID
          LESOBL(1)='RAYO'
          LESFAC(1)='RACO'
          LESFAC(2)='VECT'
          LESFAC(3)='VX  '
          LESFAC(4)='VY  '
          LESFAC(5)='VZ  '
        ENDIF
C     =================================================================
C     FORMULATION THERMIQUE
C     =================================================================
      ELSE IF (MFR2.EQ.29) THEN
C
C       Elements TUYAU
C       ==============
        IF (MFR.EQ.79 .OR. MFR.EQ.27) then
          NBROBL=1
          SEGINI NOMID
          LESOBL(1)= 'SECT'
C
C       Elements COQUE
C       ==============
        ELSE 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    '
C
C       Autres elements
C       ===============
        ELSE
          NBROBL=0
          SEGINI NOMID
        ENDIF
C     =================================================================
C     FORMULATION DIFFUSION
C     =================================================================
      ELSE IF (MFR2.EQ.73) THEN
C
C       Elements TUYAU
C       ==============
        IF (MFR.EQ.79 .OR. MFR.EQ.27) then
          NBROBL=1
          SEGINI NOMID
          LESOBL(1)= 'SECT'
C
C       Elements COQUE
C       ==============
        ELSE 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    '
C
C       Autres elements
C       ===============
        ELSE
          NBROBL=0
          SEGINI NOMID
        ENDIF
C     =================================================================
      ENDIF
C
      IF (NOMID.NE.0) THEN
        IF (IFOMOD.EQ.6) THEN
          NBRFA0 = NBRFAC
          NBRFAC = NBROBL + (NBRFA0*2)
          SEGADJ NOMID
          DO IMO = 1,NBROBL
           LESFAC(NBRFA0 + IMO)(2:4) = LESOBL(IMO)(1:3)
           LESFAC(NBRFA0 + IMO)(1:1) = 'I'
          ENDDO
          DO IMO = 1,NBRFA0
           LESFAC(NBRFA0+NBROBL+IMO)(2:4) = LESFAC(IMO)(1:3)
           LESFAC(NBRFA0+NBROBL+IMO)(1:1) = 'I'
          ENDDO
        ENDIF
      ENDIF
C
      IF (NOMID.NE.0) SEGACT,NOMID*NOMOD
      IPNOMC=NOMID
      END