Télécharger iddual.eso

Retour à la liste

iddual
C IDDUAL    SOURCE    MB234859  25/08/04    21:15:16     12339          
C=======================================================================
C=       DEFINITION DES NOMS DE COMPOSANTES DUALES                     =
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=                                                                     =
C=  Remarque : Voir INOMID ou CCOPTIO pour signification IFOUR         =
C=======================================================================
C
      SUBROUTINE IDDUAL(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
-INC SMLMOTS
C
      CHARACTER*(LOCOMP) CCOMP
      EXTERNAL LONG
C
      NBROBL=0
      NBRFAC=0
C
      IMODEL=IPMODE
      MELE  =IMODEL.NEFMOD
      MFR   =NUMMFR(MELE)
      NOMID =IMODEL.LNOMID(2)
C
C     Ne pas recreer le NOMID si deja present
      IF(NOMID.NE.0 .AND. (MFR.EQ.MFR0))THEN
        NBROBL=LESOBL(/2)
        NBRFAC=LESFAC(/2)
        IPNOMC=NOMID
        RETURN
      ENDIF
C
      MFR =MFR0
      MFR2=NUMFOR(IMODEL)
*
*     MACRO ELEMENT
*
      IF (MFR.EQ.61)THEN
        IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
          NBROBL=5
          SEGINI,NOMID
          LESOBL(1)='FX  '
          LESOBL(2)='FY  '
          LESOBL(3)='MZ  '
          LESOBL(4)='FM  '
          LESOBL(5)='MM  '
        ENDIF
C     =================================================================
C     FORMULATION THERMOHYDRIQUE
C     =================================================================
      ELSE IF (MFR2.EQ.65) THEN
        NBROBL=3
        SEGINI,NOMID
        LESOBL(1)='QG '
        LESOBL(2)='QC '
        LESOBL(3)='Q  '
C     =================================================================
C     FORMULATION MECANIQUE/CHARGEMENT/LIAISON/MELANGE/NAVIER_STOKES
C     =================================================================
      ELSE IF (MFR2.EQ.2.OR.MFR2.EQ.72.OR.MFR2.EQ.24.OR.MFR2.EQ.38
     &    .OR. MFR2.EQ.52) THEN
C
C       Cas particuliers 
C       ================
        IF (MFR.EQ.26) THEN
          NBROBL=1
          SEGINI,NOMID
          LESOBL(1)='FALF'
        ELSE IF (MFR.EQ.28) THEN
          NBROBL=1
          SEGINI,NOMID
          LESOBL(1)='FBET'
C
C       Elements MASSIFS, MEMBRANE, UNIAXIALE
C       =====================================
        ELSE IF (MFR.EQ.1 .OR. MFR.EQ.25 .OR. MFR.EQ.27 .OR. MFR.EQ.31
     &      .OR. MFR.EQ.52) THEN
          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
          ELSE IF (IFOUR.EQ.1) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FT  '
          ELSE IF (IFOUR.EQ.2) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
          ELSE IF (IFOUR.EQ.-3) THEN
            IF (MFR2.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
          ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15.AND.MFR.EQ.1) THEN
            IF (IFOUR.LE.6) THEN
              NBROBL=1
              SEGINI,NOMID
              LESOBL(1)='FX  '
            ELSE IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) THEN
              NBROBL=2
              SEGINI,NOMID
              LESOBL(1)='FX  '
              LESOBL(2)='FY  '
            ELSE IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) THEN
              NBROBL=2
              SEGINI,NOMID
              LESOBL(1)='FX  '
              LESOBL(2)='FZ  '
            ELSE IF (IFOUR.EQ.11) THEN
              NBROBL=3
              SEGINI,NOMID
              LESOBL(1)='FX  '
              LESOBL(2)='FY  '
              LESOBL(3)='FZ  '
            ELSE IF (IFOUR.EQ.12.OR.IFOUR.EQ.13.OR.IFOUR.EQ.15) THEN
              NBROBL=1
              SEGINI,NOMID
              LESOBL(1)='FR  '
            ELSE IF (IFOUR.EQ.14) THEN
              NBROBL=2
              SEGINI,NOMID
              LESOBL(1)='FR  '
              LESOBL(2)='FZ  '
            ENDIF
          ENDIF
C
C       Elements COQUE/POUTRE/TUYAU
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) THEN
          IF (IFOUR.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  '
          ELSE IF (IFOUR.EQ.1) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FT  '
            LESOBL(4)='MT  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='MT  '
          ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='MZ  '
          ELSE IF (IFOUR.EQ.-3) THEN
            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
C       Element JOINT, JOINT CISAILLEMENT,JOINT GENERALISE, COS2
C       ===============================================================
        ELSE IF (MFR.EQ.35.OR.MFR.EQ.53.OR.MFR.EQ.55.OR.MFR.EQ.78) THEN
          IF (IFOUR.EQ.2) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
          ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
          ENDIF
C
C       Elements HOMOGENEISE
C       =====================
        ELSE IF (MFR.EQ.37) THEN
          IF (IFOUR.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  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FP  '
            LESOBL(2)='FPI '
            LESOBL(3)='FR  '
            LESOBL(4)='MT  '
          ELSE IF (IFOUR.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  '
          ELSE
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FP  '
            LESOBL(2)='FPI '
            LESOBL(3)='FX  '
            LESOBL(4)='FY  '
          ENDIF
C
C       Elements 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
C       Elements ZONE_COHESIVE
C       ======================
        ELSE IF (MFR.EQ.77) THEN
C         Element ZCO2 (xfem meca rupture en 2D)
          IF(IFOUR.EQ.-2.OR.IFOUR.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         Elements ZCO3 et ZCO4 (xfem meca rupture en 3D)
          ELSE IF (IFOUR.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
C       Element XFEM 
C       ============
        ELSE IF (MFR.EQ.63) THEN
CTY       Element XQ4R (xfem meca rupture en 2D)
          IF(IFOUR.EQ.-2.OR.IFOUR.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 (IFOUR.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
        ENDIF
C     =================================================================
C     FORMULATION LIQUIDE
C     =================================================================
      ELSE IF (MFR2.EQ.11) THEN
C
C       Elements LIQUIDE
C       ================
        IF (MFR.EQ.11) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
C
C       Elements TUYAU ACOUSTIQUE PUR
C       =============================
        ELSE IF (MFR.EQ.41) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FPI '
          LESOBL(2)='FP  '
C
C       Elements SURFACE LIBRE 
C       ======================
        ELSE IF (MFR.EQ.23) THEN
          NBROBL=3
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
          LESOBL(3)='FZ  '
        ENDIF
C     =================================================================
C     FORMULATION MECANIQUE+LIQUID
C     =================================================================
      ELSE IF (MFR2.EQ.44) THEN
C
C       Element de RACCORD LIQUIDE TUYAU
C       ================================
        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
C       Element de RACCORD
C       ==================
        ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
          NBROBL=2
          SEGINI,NOMID
          LESOBL(1)='FP  '
          LESOBL(2)='FPI '
C
C       Element de RACCORD MASSIF (2e serie de composantes)
C       ====================================================
        ELSE IF (MFR.EQ.1019) THEN
          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=2
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
          ELSE IF (IFOUR.EQ.1) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FT  '
          ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
          ENDIF
C
C       Element de RACCORD COQUE (2e serie de composantes)
C       ==================================================
        ELSE IF (MFR.EQ.1021) THEN
          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='MZ  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='MT  '
          ELSE IF (IFOUR.EQ.1) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FT  '
            LESOBL(4)='MT  '
          ELSE IF (IFOUR.EQ.2.OR.IFOUR.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
        ENDIF
C     =================================================================
C     FORMULATION POREUX
C     =================================================================
      ELSE IF (MFR2.EQ.33) THEN
C
C       Element POREUX
C       ==============
        IF (MFR.EQ.33) THEN
          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FP  '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=3
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FP  '
          ELSE IF (IFOUR.EQ.1) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FT  '
            LESOBL(4)='FP  '
          ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
            LESOBL(4)='FP  '
          ENDIF
C
C       Element POREUX type Q
C       =====================
        ELSE IF (MFR.EQ.57) THEN
          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FP  '
            LESOBL(4)='FPQ '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=4
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FP  '
            LESOBL(4)='FPQ '
          ELSE IF (IFOUR.EQ.1) THEN
            NBROBL=5
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FT  '
            LESOBL(4)='FP  '
            LESOBL(5)='FPQ '
          ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
            NBROBL=5
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FZ  '
            LESOBL(4)='FP  '
            LESOBL(5)='FPQ '
          ENDIF
C
C       Element POREUX type R
C       =====================
        ELSE IF (MFR.EQ.59) THEN
          IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
            NBROBL=5
            SEGINI,NOMID
            LESOBL(1)='FX  '
            LESOBL(2)='FY  '
            LESOBL(3)='FP  '
            LESOBL(4)='FPQ '
            LESOBL(5)='FTP '
          ELSE IF (IFOUR.EQ.0) THEN
            NBROBL=5
            SEGINI,NOMID
            LESOBL(1)='FR  '
            LESOBL(2)='FZ  '
            LESOBL(3)='FP  '
            LESOBL(4)='FPQ '
            LESOBL(5)='FTP '
          ELSE IF (IFOUR.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 '
          ELSE IF (IFOUR.EQ.2.OR.IFOUR.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
        ENDIF
C     =================================================================
C     FORMULATION ELECTROSTATIQUE
C     =================================================================
      ELSE IF (MFR2.EQ.71) THEN
        NBROBL=1
        SEGINI,NOMID
        LESOBL(1)='QEL     '
C     =================================================================
C     FORMULATION HHO (SEULEMENT 2D (CP/DP) et 3D
C     =================================================================
      ELSE IF (MFR2.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 - IFOUR 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 (IFOUR.EQ.-2 .OR. IFOUR.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 (IFOUR.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     =================================================================
C     FORMULATION THERMIQUE
C     =================================================================
      ELSE IF (MFR2.EQ.29) THEN
C
C       Elements COQUE
C       ==============
        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
C
C       Autres elements
C       ===============
        ELSE
          NBROBL=1
          SEGINI NOMID
          LESOBL(1)='Q       '
        ENDIF
C     =================================================================
C     FORMULATION DIFFUSION
C     =================================================================
      ELSE IF (MFR2.EQ.73) THEN
C
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
C       Elements COQUE
C       ==============
        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
C       Autres elements
C       ===============
        ELSE
          NBROBL = 1
          SEGINI NOMID
          LESOBL(1)=CCOMP
        ENDIF
C     =================================================================
C     FORMULATION CHANGEMENT_PHASE
C     =================================================================
      ELSE IF (MFR2.EQ.30) THEN
C
        IF (IMODEL.CMATEE.EQ.'CHPH_PAR') THEN
          NBROBL=1
          NBRFAC=0
          SEGINI,NOMID
          MLMOT1=IMODEL.IVAMOD(1)
          NOMID.LESOBL(1)=MLMOT1.MOTS(2)
        ELSE IF  (IMODEL.CMATEE.EQ.'CHPH_SOL')THEN
          NBROBL=2
          NBRFAC=0
          SEGINI,NOMID
          MLMOT1=IMODEL.IVAMOD(1)
          NOMID.LESOBL(1)=MLMOT1.MOTS(3)
          NOMID.LESOBL(2)=MLMOT1.MOTS(4)
        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
 
 

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