Télécharger iddual.eso

Retour à la liste

iddual
C IDDUAL    SOURCE    OF166741  24/10/07    21:15:26     12016          
 
C=======================================================================
C=       DEFINITION DES NOMS DE COMPOSANTES PRIMALES                   =
C=       -------------------------------------------                   =
C=                                                                     =
C=  Entrees :                                                          =
C=    IPMODE    Pointeur sur un MMODEL.KMODEL                          =
C=    MFR0      Numero de Formulation                                  =
C=      - Sert seulement si different de celui calcule avec IMODEL     =
C=                                                                     =
C=  Sorties :                                                          =
C=    IPNOMC    pointeur de type NOMID sur les listes de noms de       =
C=              composantes OBLigatoires et FACultatives               =
C=    NBROBL    Nombre de composantes OBLIGATOIRES                     =
C=    NBRFAC    Nombre de composantes FACULTATIVES                     =
C=======================================================================
 
      SUBROUTINE IDDUAL(IPMODE,MFR0,IPNOMC,NBROBL,NBRFAC)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C==DEB= FORMULATION HHO == Include specifique ==========================
-INC CCHHOPA
C==FIN= FORMULATION HHO ================================================
 
-INC SMMODEL
-INC SMLMOTS
 
      CHARACTER*(LOCOMP) CCOMP
 
 
      CHARACTER*16 NOM16
      EXTERNAL LONG
 
      NOMID =0
      NBROBL=0
      NBRFAC=0
      IMODEL=IPMODE
C     On suppose que le IMODEL est actif
 
C     Recuperation de IFOUR dans CCOPTIO.INC
      IFOU  = IFOUR
      MELE  =NEFMOD
      MFR   =NUMMFR(MELE)
 
      NOMID = IMODEL.LNOMID(2)
 
C     S'ils sont déjà présents dans le IMODEL on ne se les refait pas...
      IF(NOMID .NE. 0 .AND. (MFR .EQ. MFR0))THEN
        NBROBL=LESOBL(/2)
        NBRFAC=LESFAC(/2)
        IPNOMC = NOMID
        RETURN
      ENDIF
 
C     Sinon on les détermine
      MFR = MFR0
 
C     Cas particuliers de la THERMIQUE, DIFFUSION, METALLURGIE
      NOM16=FORMOD(1)
      IF(NOM16 .EQ. 'THERMIQUE       ') GOTO 1001
      IF(NOM16 .EQ. 'DIFFUSION       ') GOTO 1002
      IF(NOM16 .EQ. 'METALLURGIE     ') GOTO 1003
 
*    formulation thermohydrique
      IF( MFR.EQ.65) THEN
         NBROBL=3
         SEGINI NOMID
         LESOBL(1)='QG '
         LESOBL(2)='QC '
         LESOBL(3)='Q  '
*
*     0/ MACRO ELEMENT
*
      ELSEIF (MFR.EQ.61)THEN
C
         IF (IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN
*
*        0-A/ CONTRAINTES PLANES - DEFORMATIONS PLANES
*
            NBROBL=5
            SEGINI NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='MZ  '
            LESOBL(4)='FM  '
            LESOBL(5)='MM  '
         ENDIF
 
C  1 - Elements COQUE (3), COQUE EPAISSE (5), POUTRE (7), COQUE en
C      CISAILLEMENT TRANSVERSE (9), TUYAU (13), LINESPRING (15), TUYAU
C      FISSURE (17), Barre excentree BAEX (49), LIA2 (51), JOI1(75)
C ====================================================================
      ELSE IF (MFR.EQ. 3.OR.MFR.EQ. 5.OR.MFR.EQ. 7.OR.MFR.EQ. 9.OR.
     .    MFR.EQ.13.OR.MFR.EQ.15.OR.MFR.EQ.17.OR.MFR.EQ.49.OR.
     .    MFR.EQ.51.OR.MFR.EQ.75.OR.MFR.EQ.74) THEN
C =====
C  1.1 - Tridimensionnel
C =====
        IF (IFOU.EQ.2) THEN
          NBROBL=6
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
          LESOBL(4)='MX  '
          LESOBL(5)='MY  '
          LESOBL(6)='MZ  '
C =====
C  1.2 - Fourier
C =====
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
          LESOBL(4)='MT  '
C =====
C  1.3 - Axisymetrie
C =====
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='MT  '
C =====
C  1.4 - Bidimensionnel PLAN (CP/DP)
C =====
        ELSE IF (IFOU.EQ.-1.OR.IFOU.EQ.-2) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='MZ  '
C =====
C  1.5 - Bidimensionnel PLAN GENE
C =====
        ELSE IF (IFOU.EQ.-3) THEN
C Ici il faut distinguer les formulations
          IF (MFR.EQ.3 .OR. MFR.EQ.5) THEN
            NBROBL=6
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='MZ  '
            LESOBL(4)='FZ  '
            LESOBL(5)='MY  '
            LESOBL(6)='MX  '
          ELSE
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='MZ  '
          ENDIF
        ENDIF
 
C  2 - Elements LIQUIDE
C ======================
      ELSE IF (MFR.EQ.11) THEN
        NBROBL=2
        SEGINI,NOMID
        LESOBL(1)='FP  '
        LESOBL(2)='FPI '
 
C  3 - Elements TUYAU ACOUSTIQUE PUR
C ===================================
      ELSE IF (MFR.EQ.41) THEN
        NBROBL=2
        SEGINI,NOMID
        LESOBL(1)='FPI '
        LESOBL(2)='FP  '
 
C  4 - Element de RACCORD LITU
C =============================
      ELSE IF (MFR.EQ.43) THEN
        NBROBL=5
        SEGINI,NOMID
        LESOBL(1)='FX  '
        LESOBL(2)='FY  '
        LESOBL(3)='FZ  '
        LESOBL(4)='FPI '
        LESOBL(5)='FP  '
 
C  5 - Elements HOMOGENEISE
C ==========================
      ELSE IF (MFR.EQ.37) THEN
C =====
C  5.1 - Fourier
C =====
        IF (IFOU.EQ.1) THEN
          NBROBL=6
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
          LESOBL(3)='FR  '
          LESOBL(4)='MT  '
          LESOBL(5)='FT  '
          LESOBL(6)='MR  '
C =====
C  5.2 - Axisymetrie
C =====
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
          LESOBL(3)='FR  '
          LESOBL(4)='MT  '
C =====
C  5.3 - Tridimensionnel
C =====
        ELSE IF (IFOU.EQ.2) THEN
          NBROBL=6
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
          LESOBL(3)='FX  '
          LESOBL(4)='MY  '
          LESOBL(5)='FY  '
          LESOBL(6)='MX  '
C =====
C  5.4 - Bidimensionnel PLAN (DP/CP/DPGE)
C =====
        ELSE
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
          LESOBL(3)='FX  '
          LESOBL(4)='FY  '
        ENDIF
 
C  6 - Element de SURFACE LIBRE
C ==============================
      ELSE IF (MFR.EQ.23) THEN
        NBROBL=3
        SEGINI,NOMID
        LESOBL(1)='FP  '
        LESOBL(2)='FPI '
        LESOBL(3)='FZ  '
 
C  7 - Element JOINT (35),JOINT CISAILLEMENT (53),JOINT GENERALISE (55)
C =====================================================================
c cccccc
        ELSE IF (MFR.EQ.35.OR.MFR.EQ.53.OR.MFR.EQ.55.OR.MFR.EQ.78) THEN
c cccccc
C =====
C  7.1 - Tridimensionnel
C =====
        IF (IFOU.EQ.2) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
C =====
C  7.2 - Bidimensionnel PLAN (CP/DP/DPGE)
C =====
        ELSE IF (IFOU.EQ.-1.OR.IFOU.EQ.-2.OR.IFOU.EQ.-3) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
C =====
C  7.3 - Axisymetrie
C =====
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
        ENDIF
 
C  8 - Elements MASSIFS, de MEMBRANE (25), UNIAXIALE (27)
C     NAVIER_STOKES(52)
C ========================================================
      ELSE IF (MFR.EQ.1.OR.MFR.EQ.25.OR.MFR.EQ.27.OR.MFR.EQ.31.OR.
     $         MFR.EQ.72.OR.MFR.EQ.52) THEN
C =====
C  8.1 - Bidimensionnel PLAN (CP/DP)
C =====
        IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
C =====
C  8.2 - Axisymetrie
C =====
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
C =====
C  8.3 - Fourier
C =====
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
C =====
C  8.4 - Tridimensionnel
C =====
        ELSE IF (IFOU.EQ.2) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
C =====
C  8.5 - Bidimensionnel PLAN DPGE
C =====
        ELSE IF (IFOU.EQ.-3) THEN
          IF (MFR.EQ.72) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
          ELSE
            NBROBL=5
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
            LESOBL(4)='MY  '
            LESOBL(5)='MX  '
          ENDIF
C =====
C  8.6 - Unidimensionnel (1D)
C =====
        ELSE IF (IFOU.GE.3.AND.IFOU.LE.15.AND.MFR.EQ.1) THEN
          IF (IFOU.LE.6) THEN
            NBROBL=1
            SEGINI,NOMID
            LESOBL(1)='FX  '
          ELSE IF (IFOU.EQ.7.OR.IFOU.EQ.8) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
          ELSE IF (IFOU.EQ.9.OR.IFOU.EQ.10) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FZ  '
          ELSE IF (IFOU.EQ.11) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
          ELSE IF (IFOU.EQ.12.OR.IFOU.EQ.13.OR.IFOU.EQ.15) THEN
            NBROBL=1
            SEGINI,NOMID
            LESOBL(1)='FR  '
          ELSE IF (IFOU.EQ.14) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
          ENDIF
        ENDIF
 
C  10 - Formulation POREUX
C =========================
      ELSE IF (MFR.EQ.33) THEN
C ======
C  10.1 - Bidimensionnel PLAN (CP/DP)
C ======
        IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FP  '
C ======
C  10.2 - Axisymetrie
C ======
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FP  '
C ======
C  10.3 - Fourier
C ======
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
          LESOBL(4)='FP  '
C ======
C  10.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
C ======
        ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
          LESOBL(4)='FP  '
        ENDIF
 
C  11 - Formulation POREUX type Q
C ================================
      ELSE IF (MFR.EQ.57) THEN
C ======
C  11.1 - Bidimensionnel PLAN (CP/DP)
C ======
        IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FP  '
          LESOBL(4)='FPQ '
C ======
C  11.2 - Axisymetrie
C ======
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FP  '
          LESOBL(4)='FPQ '
C ======
C  11.3 - Fourier
C ======
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=5
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
          LESOBL(4)='FP  '
          LESOBL(5)='FPQ '
C ======
C  11.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
C ======
        ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
          NBROBL=5
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
          LESOBL(4)='FP  '
          LESOBL(5)='FPQ '
        ENDIF
 
C  12 - Formulation POREUX type R
C ================================
      ELSE IF (MFR.EQ.59) THEN
C ======
C  12.1 - Bidimensionnel PLAN (CP/DP)
C ======
        IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
          NBROBL=5
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FP  '
          LESOBL(4)='FPQ '
          LESOBL(5)='FTP '
C ======
C  12.2 - Axisymetrie
C ======
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=5
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FP  '
          LESOBL(4)='FPQ '
          LESOBL(5)='FTP '
C ======
C  12.3 - Fourier
C ======
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=6
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
          LESOBL(4)='FP  '
          LESOBL(5)='FPQ '
          LESOBL(6)='FTP '
C ======
C  12.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
C ======
        ELSE IF (IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
          NBROBL=6
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
          LESOBL(4)='FP  '
          LESOBL(5)='FPQ '
          LESOBL(6)='FTP '
        ENDIF
 
C  13 - Elements de RACCORD
C ==========================
      ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
        NBROBL=2
        SEGINI,NOMID
        LESOBL(1)='FP  '
        LESOBL(2)='FPI '
 
C  14 - Element de RACCORD MASSIF (2e serie de composantes)
C ==========================================================
      ELSE IF (MFR.EQ.1019) THEN
C ======
C  14.1 - Bidimensionnel PLAN (CP/DP)
C ======
        IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
C ======
C  14.2 - Axisymetrie
C ======
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
C ======
C  14.3 - Fourier
C ======
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
C ======
C  14.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
C ======
        ELSE IF(IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
        ENDIF
 
C  15 - Element de RACCORD COQUE (2e serie de composantes)
C =========================================================
      ELSE IF (MFR.EQ.1021) THEN
C ======
C  15.1 - Bidimensionnel PLAN (CP/DP)
C ======
        IF (IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='MZ  '
C ======
C  15.2 - Axisymetrie
C ======
        ELSE IF (IFOU.EQ.0) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='MT  '
C ======
C  15.3 - Fourier
C ======
        ELSE IF (IFOU.EQ.1) THEN
          NBROBL=4
          SEGINI,NOMID
          LESOBL(1)='FR  '
          LESOBL(2)='FZ  '
          LESOBL(3)='FT  '
          LESOBL(4)='MT  '
C ======
C  15.4 - Tridimensionnel et bidimensionnel DEFO PLAN GENE
C ======
        ELSE IF(IFOU.EQ.2.OR.IFOU.EQ.-3) THEN
          NBROBL=6
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='FZ  '
          LESOBL(4)='MX  '
          LESOBL(5)='MY  '
          LESOBL(6)='MZ  '
        ENDIF
 
C  16 - Element TUYO
C ===================
      ELSE IF (MFR.EQ.39) THEN
        NBROBL=6+9
        SEGINI,NOMID
        LESOBL(1)='FX  '
        LESOBL(2)='FY  '
        LESOBL(3)='FZ  '
        LESOBL(4)='MX  '
        LESOBL(5)='MY  '
        LESOBL(6)='MZ  '
        LESOBL(7)='FW0 '
        LESOBL(8)='FU1 '
        LESOBL(9)='FU2 '
        LESOBL(10)='FU3 '
        LESOBL(11)='FU4 '
        LESOBL(12)='FW1 '
        LESOBL(13)='FW2 '
        LESOBL(14)='FW3 '
        LESOBL(15)='FW4 '
C  17 - Element POI1 materiau MODAL
C ===================
      ELSE IF (MFR.EQ.26) THEN
        NBROBL=1
        SEGINI,NOMID
        LESOBL(1)='FALF'
C  18 - Element POI1 materiau STATIQUE
C ===================
      ELSE IF (MFR.EQ.28) THEN
        NBROBL=1
        SEGINI,NOMID
        LESOBL(1)='FBET'
C 19 - Element XQ4R (xfem meca rupture)
C==================
      ELSEIF(MFR.EQ.63) THEN
CTY  - Element XQ4R (xfem meca rupture en 2D)
       IF(IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
        NBROBL=2
        NBRFAC=18
        SEGINI,NOMID
        LESOBL(1)='FX  '
        LESOBL(2)='FY  '
        LESFAC(1)='FAX '
        LESFAC(2)='FAY '
        LESFAC(3)='FB1X'
        LESFAC(4)='FB1Y'
        LESFAC(5)='FC1X'
        LESFAC(6)='FC1Y'
        LESFAC(7)='FD1X'
        LESFAC(8)='FD1Y'
        LESFAC(9)='FE1X'
        LESFAC(10)='FE1Y'
        LESFAC(11)='FB2X'
        LESFAC(12)='FB2Y'
        LESFAC(13)='FC2X'
        LESFAC(14)='FC2Y'
        LESFAC(15)='FD2X'
        LESFAC(16)='FD2Y'
        LESFAC(17)='FE2X'
        LESFAC(18)='FE2Y'
CTY  - Element XC8R (xfem meca rupture en 3D)
       ELSE IF (IFOU.EQ.2) THEN
        NBROBL=3
        NBRFAC=27
        SEGINI,NOMID
        LESOBL(1)='FX  '
        LESOBL(2)='FY  '
        LESOBL(3)='FZ  '
        LESFAC(1)='FAX '
        LESFAC(2)='FAY '
        LESFAC(3)='FAZ '
        LESFAC(4)='FB1X'
        LESFAC(5)='FB1Y'
        LESFAC(6)='FB1Z'
        LESFAC(7)='FC1X'
        LESFAC(8)='FC1Y'
        LESFAC(9)='FC1Z'
        LESFAC(10)='FD1X'
        LESFAC(11)='FD1Y'
        LESFAC(12)='FD1Z'
        LESFAC(13)='FE1X'
        LESFAC(14)='FE1Y'
        LESFAC(15)='FE1Z'
        LESFAC(16)='FB2X'
        LESFAC(17)='FB2Y'
        LESFAC(18)='FB2Z'
        LESFAC(19)='FC2X'
        LESFAC(20)='FC2Y'
        LESFAC(21)='FC2Z'
        LESFAC(22)='FD2X'
        LESFAC(23)='FD2Y'
        LESFAC(24)='FD2Z'
        LESFAC(25)='FE2X'
        LESFAC(26)='FE2Y'
        LESFAC(27)='FE2Z'
       ENDIF
 
 
C 20 - Elements de zones cohesives
C=================================
      ELSEIF(MFR.EQ.77) THEN
C    - Element ZCO2 (xfem meca rupture en 2D)
       IF(IFOU.EQ.-2.OR.IFOU.EQ.-1) THEN
        NBROBL=2
        NBRFAC=18
        SEGINI,NOMID
        LESOBL(1)='FAX '
        LESOBL(2)='FAY '
        LESFAC(1)='FX  '
        LESFAC(2)='FY  '
        LESFAC(3)='FB1X'
        LESFAC(4)='FB1Y'
        LESFAC(5)='FC1X'
        LESFAC(6)='FC1Y'
        LESFAC(7)='FD1X'
        LESFAC(8)='FD1Y'
        LESFAC(9)='FE1X'
        LESFAC(10)='FE1Y'
        LESFAC(11)='FB2X'
        LESFAC(12)='FB2Y'
        LESFAC(13)='FC2X'
        LESFAC(14)='FC2Y'
        LESFAC(15)='FD2X'
        LESFAC(16)='FD2Y'
        LESFAC(17)='FE2X'
        LESFAC(18)='FE2Y'
C    - Element ZCO3 et ZCO4 (xfem meca rupture en 3D)
       ELSE IF (IFOU.EQ.2) THEN
        NBROBL=3
        NBRFAC=27
        SEGINI,NOMID
        LESOBL(1)='FAX '
        LESOBL(2)='FAY '
        LESOBL(3)='FAZ '
        LESFAC(1)='FX  '
        LESFAC(2)='FY  '
        LESFAC(3)='FZ  '
        LESFAC(4)='FB1X'
        LESFAC(5)='FB1Y'
        LESFAC(6)='FB1Z'
        LESFAC(7)='FC1X'
        LESFAC(8)='FC1Y'
        LESFAC(9)='FC1Z'
        LESFAC(10)='FD1X'
        LESFAC(11)='FD1Y'
        LESFAC(12)='FD1Z'
        LESFAC(13)='FE1X'
        LESFAC(14)='FE1Y'
        LESFAC(15)='FE1Z'
        LESFAC(16)='FB2X'
        LESFAC(17)='FB2Y'
        LESFAC(18)='FB2Z'
        LESFAC(19)='FC2X'
        LESFAC(20)='FC2Y'
        LESFAC(21)='FC2Z'
        LESFAC(22)='FD2X'
        LESFAC(23)='FD2Y'
        LESFAC(24)='FD2Z'
        LESFAC(25)='FE2X'
        LESFAC(26)='FE2Y'
        LESFAC(27)='FE2Z'
       ENDIF
 
C  21 - Formulation ELECTROSTATIQUE (base MASSIF)
C ==================================
      ELSE IF (MFR.EQ.71) THEN
        NBROBL=1
        SEGINI,NOMID
        LESOBL(1)='QEL     '
 
C=DEB==== FORMULATION HHO ==============================================
C Pour l'instant HHO en MECANIQUE seulement en 2D PLAN (CP/DP) et 3D
      ELSE IF (MFR.EQ.HHO_MFR_ELEMENT) THEN
        i_d_c = IDIM
        n_o_c = ABS(imodel.INFMOD(12))
        n_d_c = n_o_c * i_d_c
        n_o_f = ABS(imodel.INFMOD( 9))
        n_d_f = n_o_f * i_d_c
 
        NBROBL = n_d_c + n_d_f
        NBRFAC = 0
        SEGINI,NOMID
 
        j1 = 1
        j2 = j1 + n_o_c
        j3 = j2 + n_o_c
        n_o_c = n_o_c - 1
        IF (IFOUR.EQ.-2 .OR. IFOUR.EQ.-1) THEN
          DO i = 0, n_o_c
c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'FX_HC_',i
c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'FY_HC_',i
            WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'FXC',i,'    '
            WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'FYC',i,'    '
          END DO
        ELSE IF (IFOUR.EQ.2) THEN
          DO i = 0, n_o_c
c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'FX_HC_',i
c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'FY_HC_',i
c***            WRITE(LESOBL(j3+i),'(A6,I2.2)') 'FZ_HC_',i
            WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'FXC',i,'    '
            WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'FYC',i,'    '
            WRITE(LESOBL(j3+i),'(A3,I1.1,A4)') 'FZC',i,'    '
          END DO
        ELSE
          write(ioimp,*) 'IDDUAL - HHO - IFOU not implemented'
          CALL ERREUR(5)
          RETURN
        END IF
 
        j1 = n_d_c + 1
        j2 = j1 + n_o_f
        j3 = j2 + n_o_f
        n_o_f = n_o_f - 1
        IF (IFOU.EQ.-2 .OR. IFOU.EQ.-1) THEN
          DO i = 0, n_o_f
c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'FX_HF_',i
c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'FY_HF_',i
            WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'FXF',i,'    '
            WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'FYF',i,'    '
          END DO
        ELSE IF (IFOU.EQ.2) THEN
          DO i = 0, n_o_f
c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'FX_HF_',i
c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'FY_HF_',i
c***            WRITE(LESOBL(j3+i),'(A6,I2.2)') 'FZ_HF_',i
            WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'FXF',i,'    '
            WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'FYF',i,'    '
            WRITE(LESOBL(j3+i),'(A3,I1.1,A4)') 'FZF',i,'    '
          END DO
        END IF
C=FIN==== FORMULATION HHO ==============================================
 
      ENDIF
 
C  Par DEFAUT : segment VIDE
C ===========================
      IF (NOMID.EQ.0) THEN
        SEGINI,NOMID
      ELSE
        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
 
      SEGACT,NOMID*NOMOD
      IPNOMC=NOMID
      RETURN
 
C  9 - Formulation THERMIQUE
C ===========================
1001  CONTINUE
C     Cas des COQUES
      IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
        NPINT = infmod(1)
        IF(NPINT.EQ.0) THEN
           NBROBL=3
           SEGINI NOMID
           LESOBL(1)='QINF    '
           LESOBL(2)='Q       '
           LESOBL(3)='QSUP    '
        ELSE
           NBROBL = 1
           SEGINI NOMID
           LESOBL(1)='Q       '
        ENDIF
*
*---     TOUS LES CAS SAUF COQUES ET COQUES EPAISSES
*
      ELSE
        NBROBL=1
        SEGINI NOMID
        LESOBL(1)='Q       '
      ENDIF
      SEGACT,NOMID*NOMOD
      IPNOMC=NOMID
      RETURN
 
C  22 - Formulation DIFFUSION
C ===========================
1002  CONTINUE
C     Recuperation du LISTMOTS dans IVAMOD(1)
      MLMOT1=IVAMOD(1)
 
C     Recuperation de l'inconnue DUALE
      CCOMP =MLMOT1.MOTS(2)
      NBCHAR=LONG(CCOMP)
      IF (NBCHAR .GT. 4) THEN
        CALL ERREUR(536)
        RETURN
      ENDIF
 
C     Cas des COQUES
      IF (MFR.EQ.3 .OR. MFR.EQ.5 .OR. MFR.EQ.9) THEN
 
        NPINT=infmod(1)
        IF(NPINT.EQ.0) THEN
           NBROBL=3
           SEGINI NOMID
           LESOBL(1)=CCOMP(1:NBCHAR)//'IN     '
           LESOBL(2)=CCOMP
           LESOBL(3)=CCOMP(1:NBCHAR)//'SU     '
        ELSE
           NBROBL = 1
           SEGINI NOMID
           LESOBL(1)=CCOMP
        ENDIF
 
C     Cas des autres elements
      ELSE
        NBROBL = 1
        SEGINI NOMID
        LESOBL(1)=CCOMP
      ENDIF
 
      SEGACT,NOMID*NOMOD
      IPNOMC=NOMID
      RETURN
 
C  23 - Formulation METALLURGIE
C ==================================
1003  CONTINUE
        NBROBL=0
        NBRFAC=0
        SEGINI NOMID
        SEGACT,NOMID*NOMOD
        IPNOMC=NOMID
      RETURN
 
      END
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales