Télécharger la plaquette Cast3M


fr en

Télécharger idprim.eso

Retour à la liste

Numérotation des lignes : 

idprim

  1. C IDPRIM    SOURCE    OF166741  26/02/23    21:15:19     12480          
  2. C=======================================================================
  3. C=       DEFINITION DES NOMS DE COMPOSANTES PRIMALES                   =
  4. C=       -------------------------------------------                   =
  5. C=                                                                     =
  6. C=  Entrees :                                                          =
  7. C=    IPMODE    Pointeur sur un MMODEL.KMODEL                          =
  8. C=    MFR0      Numero de Formulation                                  =
  9. C=      - Sert seulement si different de celui calcule avec IMODEL     =
  10. C=                                                                     =
  11. C=  Sorties :                                                          =
  12. C=    IPNOMC    pointeur de type NOMID sur les listes de noms de       =
  13. C=              composantes OBLigatoires et FACultatives               =
  14. C=    NBROBL    Nombre de composantes OBLIGATOIRES                     =
  15. C=    NBRFAC    Nombre de composantes FACULTATIVES                     =
  16. C=                                                                     =
  17. C=  Remarque : Voir INOMID ou CCOPTIO pour signification IFOUR         =
  18. C=======================================================================
  19. C
  20.       SUBROUTINE IDPRIM(IPMODE,MFR0,IPNOMC,NBROBL,NBRFAC)
  21. C
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24. C
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. C==DEB= FORMULATION HHO == Include specifique ==========================
  28. -INC CCHHOPA
  29. C==FIN= FORMULATION HHO ================================================
  30. C
  31. -INC SMMODEL
  32. -INC SMLMOTS
  33. C
  34.       CHARACTER*(LOCOMP) CCOMP
  35.       EXTERNAL LONG
  36. C
  37.       NBROBL=0
  38.       NBRFAC=0
  39. C
  40.       IMODEL=IPMODE
  41.       MELE  =IMODEL.NEFMOD
  42.       MFR   =NUMMFR(MELE)
  43.       NOMID =IMODEL.LNOMID(1)
  44. C
  45. C     Ne pas recreer le NOMID si deja present
  46.       IF(NOMID.NE.0 .AND. (MFR.EQ.MFR0))THEN
  47.         NBROBL=LESOBL(/2)
  48.         NBRFAC=LESFAC(/2)
  49.         IPNOMC=NOMID
  50.         RETURN
  51.       ENDIF
  52. C
  53.       MFR =MFR0
  54.       MFR2=NUMFOR(IMODEL)
  55. *
  56. *     MACRO ELEMENT
  57. *
  58.       IF (MFR.EQ.61)THEN
  59.         IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  60.           NBROBL=5
  61.           SEGINI,NOMID
  62.           LESOBL(1)='UX  '
  63.           LESOBL(2)='UY  '
  64.           LESOBL(3)='RZ  '
  65.           LESOBL(4)='UM  '
  66.           LESOBL(5)='RM  '
  67.         ENDIF
  68. C     =================================================================
  69. C     FORMULATION THERMOHYDRIQUE
  70. C     =================================================================
  71.       ELSE IF (MFR2.EQ.65) THEN
  72.         NBROBL=3
  73.         SEGINI,NOMID
  74.         LESOBL(1)='PG  '
  75.         LESOBL(2)='PC  '
  76.         LESOBL(3)='T   '
  77. C     =================================================================
  78. C     FORMULATION MECANIQUE/CHARGEMENT/LIAISON/MELANGE/NAVIER_STOKES
  79. C     =================================================================
  80.       ELSE IF (MFR2.EQ.2.OR.MFR2.EQ.72.OR.MFR2.EQ.24.OR.MFR2.EQ.38
  81.      &    .OR. MFR2.EQ.52) THEN
  82. C
  83. C       Cas particuliers 
  84. C       ================
  85.         IF (MFR.EQ.26) THEN
  86.           NBROBL=1
  87.           SEGINI,NOMID
  88.           LESOBL(1)='ALFA'
  89.         ELSE IF (MFR.EQ.28) THEN
  90.           NBROBL=1
  91.           SEGINI,NOMID
  92.           LESOBL(1)='BETA'
  93. C
  94. C       Elements MASSIFS, MEMBRANE, UNIAXIALE
  95. C       =====================================
  96.         ELSE IF (MFR.EQ.1 .OR. MFR.EQ.25 .OR. MFR.EQ.27 .OR. MFR.EQ.31
  97.      &      .OR. MFR.EQ.52) THEN
  98.           IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  99.             NBROBL=2
  100.             SEGINI,NOMID
  101.             LESOBL(1)='UX  '
  102.             LESOBL(2)='UY  '
  103.           ELSE IF (IFOUR.EQ.0) THEN
  104.             NBROBL=2
  105.             SEGINI,NOMID
  106.             LESOBL(1)='UR  '
  107.             LESOBL(2)='UZ  '
  108.           ELSE IF (IFOUR.EQ.1) THEN
  109.             NBROBL=3
  110.             SEGINI,NOMID
  111.             LESOBL(1)='UR  '
  112.             LESOBL(2)='UZ  '
  113.             LESOBL(3)='UT  '
  114.           ELSE IF (IFOUR.EQ.2) THEN
  115.             NBROBL=3
  116.             SEGINI,NOMID
  117.             LESOBL(1)='UX  '
  118.             LESOBL(2)='UY  '
  119.             LESOBL(3)='UZ  '
  120.           ELSE IF (IFOUR.EQ.-3) THEN
  121.             NBROBL=5
  122.             SEGINI,NOMID
  123.             LESOBL(1)='UX  '
  124.             LESOBL(2)='UY  '
  125.             LESOBL(3)='UZ  '
  126.             LESOBL(4)='RY  '
  127.             LESOBL(5)='RX  '
  128.           ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15.AND.MFR.EQ.1) THEN
  129.             IF (IFOUR.LE.6) THEN
  130.               NBROBL=1
  131.               SEGINI,NOMID
  132.               LESOBL(1)='UX  '
  133.             ELSE IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) THEN
  134.               NBROBL=2
  135.               SEGINI,NOMID
  136.               LESOBL(1)='UX  '
  137.               LESOBL(2)='UY  '
  138.             ELSE IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) THEN
  139.               NBROBL=2
  140.               SEGINI,NOMID
  141.               LESOBL(1)='UX  '
  142.               LESOBL(2)='UZ  '
  143.             ELSE IF (IFOUR.EQ.11) THEN
  144.               NBROBL=3
  145.               SEGINI,NOMID
  146.               LESOBL(1)='UX  '
  147.               LESOBL(2)='UY  '
  148.               LESOBL(3)='UZ  '
  149.             ELSE IF (IFOUR.EQ.12.OR.IFOUR.EQ.13.OR.IFOUR.EQ.15) THEN
  150.               NBROBL=1
  151.               SEGINI,NOMID
  152.               LESOBL(1)='UR  '
  153.             ELSE IF (IFOUR.EQ.14) THEN
  154.               NBROBL=2
  155.               SEGINI,NOMID
  156.               LESOBL(1)='UR  '
  157.               LESOBL(2)='UZ  '
  158.             ENDIF
  159.           ENDIF
  160. C
  161. C       Elements COQUE/POUTRE/TUYAU
  162. C       ===========================
  163.         ELSE IF (MFR.EQ.3  .OR. MFR.EQ.5 .OR. MFR.EQ.7  .OR. MFR.EQ.9 
  164.      &      .OR. MFR.EQ.13 .OR. MFR.EQ.15.OR. MFR.EQ.17 .OR. MFR.EQ.49
  165.      &      .OR. MFR.EQ.51 .OR. MFR.EQ.75) THEN
  166.           IF (IFOUR.EQ.2) THEN
  167.             NBROBL=6
  168.             SEGINI,NOMID
  169.             LESOBL(1)='UX  '
  170.             LESOBL(2)='UY  '
  171.             LESOBL(3)='UZ  '
  172.             LESOBL(4)='RX  '
  173.             LESOBL(5)='RY  '
  174.             LESOBL(6)='RZ  '
  175.           ELSE IF (IFOUR.EQ.1) THEN
  176.             NBROBL=4
  177.             SEGINI,NOMID
  178.             LESOBL(1)='UR  '
  179.             LESOBL(2)='UZ  '
  180.             LESOBL(3)='UT  '
  181.             LESOBL(4)='RT  '
  182.           ELSE IF (IFOUR.EQ.0) THEN
  183.             NBROBL=3
  184.             SEGINI,NOMID
  185.             LESOBL(1)='UR  '
  186.             LESOBL(2)='UZ  '
  187.             LESOBL(3)='RT  '
  188.           ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  189.             NBROBL=3
  190.             SEGINI,NOMID
  191.             LESOBL(1)='UX  '
  192.             LESOBL(2)='UY  '
  193.             LESOBL(3)='RZ  '
  194.           ELSE IF (IFOUR.EQ.-3) THEN
  195.             IF (MFR.EQ.3 .OR. MFR.EQ.5) THEN
  196.               NBROBL=6
  197.               SEGINI,NOMID
  198.               LESOBL(1)='UX  '
  199.               LESOBL(2)='UY  '
  200.               LESOBL(3)='RZ  '
  201.               LESOBL(4)='UZ  '
  202.               LESOBL(5)='RY  '
  203.               LESOBL(6)='RX  '
  204.             ELSE
  205.               NBROBL=3
  206.               SEGINI,NOMID
  207.               LESOBL(1)='UX  '
  208.               LESOBL(2)='UY  '
  209.               LESOBL(3)='RZ  '
  210.             ENDIF
  211.           ENDIF
  212. C
  213. C       Element JOINT, JOINT CISAILLEMENT,JOINT GENERALISE, COS2
  214. C       ===============================================================
  215.         ELSE IF (MFR.EQ.35.OR.MFR.EQ.53.OR.MFR.EQ.55.OR.MFR.EQ.78) THEN
  216.           IF (IFOUR.EQ.2) THEN
  217.             NBROBL=3
  218.             SEGINI,NOMID
  219.             LESOBL(1)='UX  '
  220.             LESOBL(2)='UY  '
  221.             LESOBL(3)='UZ  '
  222.           ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN
  223.             NBROBL=2
  224.             SEGINI,NOMID
  225.             LESOBL(1)='UX  '
  226.             LESOBL(2)='UY  '
  227.           ELSE IF (IFOUR.EQ.0) THEN
  228.             NBROBL=2
  229.             SEGINI,NOMID
  230.             LESOBL(1)='UR  '
  231.             LESOBL(2)='UZ  '
  232.           ENDIF
  233. C
  234. C       Elements HOMOGENEISE
  235. C       =====================
  236.         ELSE IF (MFR.EQ.37) THEN
  237.           IF (IFOUR.EQ.1) THEN
  238.             NBROBL=6
  239.             SEGINI,NOMID
  240.             LESOBL(1)='P   '
  241.             LESOBL(2)='PI  '
  242.             LESOBL(3)='UR  '
  243.             LESOBL(4)='RT  '
  244.             LESOBL(5)='UT  '
  245.             LESOBL(6)='RR  '
  246.           ELSE IF (IFOUR.EQ.0) THEN
  247.             NBROBL=4
  248.             SEGINI,NOMID
  249.             LESOBL(1)='P   '
  250.             LESOBL(2)='PI  '
  251.             LESOBL(3)='UR  '
  252.             LESOBL(4)='RT  '
  253.           ELSE IF (IFOUR.EQ.2) THEN
  254.             NBROBL=6
  255.             SEGINI,NOMID
  256.             LESOBL(1)='P   '
  257.             LESOBL(2)='PI  '
  258.             LESOBL(3)='UX  '
  259.             LESOBL(4)='RY  '
  260.             LESOBL(5)='UY  '
  261.             LESOBL(6)='RX  '
  262.           ELSE
  263.             NBROBL=4
  264.             SEGINI,NOMID
  265.             LESOBL(1)='P   '
  266.             LESOBL(2)='PI  '
  267.             LESOBL(3)='UX  '
  268.             LESOBL(4)='UY  '
  269.           ENDIF
  270. C
  271. C       Elements TUYO
  272. C       =============
  273.         ELSE IF (MFR.EQ.39) THEN
  274.           NBROBL=6+9
  275.           SEGINI,NOMID
  276.           LESOBL(1)='UX  '
  277.           LESOBL(2)='UY  '
  278.           LESOBL(3)='UZ  '
  279.           LESOBL(4)='RX  '
  280.           LESOBL(5)='RY  '
  281.           LESOBL(6)='RZ  '
  282.           LESOBL(7)='W0  '
  283.           LESOBL(8)='U1  '
  284.           LESOBL(9)='U2  '
  285.           LESOBL(10)='U3  '
  286.           LESOBL(11)='U4  '
  287.           LESOBL(12)='W1  '
  288.           LESOBL(13)='W2  '
  289.           LESOBL(14)='W3  '
  290.           LESOBL(15)='W4  '
  291. C
  292. C       Elements ZONE_COHESIVE
  293. C       ======================
  294.         ELSE IF (MFR.EQ.77) THEN
  295. C         Element ZCO2 (xfem meca rupture en 2D)
  296.           IF(IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  297.             NBROBL=2
  298.             NBRFAC=18
  299.             SEGINI,NOMID
  300.             LESOBL(1)='AX  '
  301.             LESOBL(2)='AY  '
  302.             LESFAC(1)='UX  '
  303.             LESFAC(2)='UY  '
  304.             LESFAC(3)='B1X '
  305.             LESFAC(4)='B1Y '
  306.             LESFAC(5)='C1X '
  307.             LESFAC(6)='C1Y '
  308.             LESFAC(7)='D1X '
  309.             LESFAC(8)='D1Y '
  310.             LESFAC(9)='E1X '
  311.             LESFAC(10)='E1Y '
  312.             LESFAC(11)='B2X '
  313.             LESFAC(12)='B2Y '
  314.             LESFAC(13)='C2X '
  315.             LESFAC(14)='C2Y '
  316.             LESFAC(15)='D2X '
  317.             LESFAC(16)='D2Y '
  318.             LESFAC(17)='E2X '
  319.             LESFAC(18)='E2Y '
  320. C         Elements ZCO3 et ZCO4 (xfem meca rupture en 3D)
  321.           ELSE IF (IFOUR.EQ.2) THEN
  322.             NBROBL=3
  323.             NBRFAC=27
  324.             SEGINI,NOMID
  325.             LESOBL(1)='AX  '
  326.             LESOBL(2)='AY  '
  327.             LESOBL(3)='AZ  '
  328.             LESFAC(1)='UX  '
  329.             LESFAC(2)='UY  '
  330.             LESFAC(3)='UZ  '
  331.             LESFAC(4)='B1X '
  332.             LESFAC(5)='B1Y '
  333.             LESFAC(6)='B1Z '
  334.             LESFAC(7)='C1X '
  335.             LESFAC(8)='C1Y '
  336.             LESFAC(9)='C1Z '
  337.             LESFAC(10)='D1X '
  338.             LESFAC(11)='D1Y '
  339.             LESFAC(12)='D1Z '
  340.             LESFAC(13)='E1X '
  341.             LESFAC(14)='E1Y '
  342.             LESFAC(15)='E1Z '
  343.             LESFAC(16)='B2X '
  344.             LESFAC(17)='B2Y '
  345.             LESFAC(18)='B2Z '
  346.             LESFAC(19)='C2X '
  347.             LESFAC(20)='C2Y '
  348.             LESFAC(21)='C2Z '
  349.             LESFAC(22)='D2X '
  350.             LESFAC(23)='D2Y '
  351.             LESFAC(24)='D2Z '
  352.             LESFAC(25)='E2X '
  353.             LESFAC(26)='E2Y '
  354.             LESFAC(27)='E2Z '
  355.           ENDIF
  356. C
  357. C       Element XFEM 
  358. C       ============
  359.         ELSE IF (MFR.EQ.63) THEN
  360. CTY       Element XQ4R (xfem meca rupture en 2D)
  361.           IF(IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  362.             NBROBL=2
  363.             NBRFAC=18
  364.             SEGINI,NOMID
  365.             LESOBL(1)='UX  '
  366.             LESOBL(2)='UY  '
  367.             LESFAC(1)='AX  '
  368.             LESFAC(2)='AY  '
  369.             LESFAC(3)='B1X '
  370.             LESFAC(4)='B1Y '
  371.             LESFAC(5)='C1X '
  372.             LESFAC(6)='C1Y '
  373.             LESFAC(7)='D1X '
  374.             LESFAC(8)='D1Y '
  375.             LESFAC(9)='E1X '
  376.             LESFAC(10)='E1Y '
  377.             LESFAC(11)='B2X '
  378.             LESFAC(12)='B2Y '
  379.             LESFAC(13)='C2X '
  380.             LESFAC(14)='C2Y '
  381.             LESFAC(15)='D2X '
  382.             LESFAC(16)='D2Y '
  383.             LESFAC(17)='E2X '
  384.             LESFAC(18)='E2Y '
  385. CTY       Element XC8R (xfem meca rupture en 3D)
  386.           ELSE IF (IFOUR.EQ.2) THEN
  387.             NBROBL=3
  388.             NBRFAC=27
  389.             SEGINI,NOMID
  390.             LESOBL(1)='UX  '
  391.             LESOBL(2)='UY  '
  392.             LESOBL(3)='UZ  '
  393.             LESFAC(1)='AX  '
  394.             LESFAC(2)='AY  '
  395.             LESFAC(3)='AZ  '
  396.             LESFAC(4)='B1X '
  397.             LESFAC(5)='B1Y '
  398.             LESFAC(6)='B1Z '
  399.             LESFAC(7)='C1X '
  400.             LESFAC(8)='C1Y '
  401.             LESFAC(9)='C1Z '
  402.             LESFAC(10)='D1X '
  403.             LESFAC(11)='D1Y '
  404.             LESFAC(12)='D1Z '
  405.             LESFAC(13)='E1X '
  406.             LESFAC(14)='E1Y '
  407.             LESFAC(15)='E1Z '
  408.             LESFAC(16)='B2X '
  409.             LESFAC(17)='B2Y '
  410.             LESFAC(18)='B2Z '
  411.             LESFAC(19)='C2X '
  412.             LESFAC(20)='C2Y '
  413.             LESFAC(21)='C2Z '
  414.             LESFAC(22)='D2X '
  415.             LESFAC(23)='D2Y '
  416.             LESFAC(24)='D2Z '
  417.             LESFAC(25)='E2X '
  418.             LESFAC(26)='E2Y '
  419.             LESFAC(27)='E2Z '
  420.           ENDIF
  421. C
  422. C       FORMULATION HHO MECANIQUE (SEULEMENT 2D (CP/DP) et 3D
  423. C       =====================================================
  424.         ELSE IF (MFR.EQ.HHO_MFR_ELEMENT) THEN
  425.           i_d_c = IDIM
  426.           n_o_c = ABS(imodel.INFMOD(12))
  427.           n_d_c = n_o_c * i_d_c
  428.           n_o_f = ABS(imodel.INFMOD( 9))
  429.           n_d_f = n_o_f * i_d_c
  430.  
  431.           NBROBL = n_d_c + n_d_f
  432.           NBRFAC = 0
  433.           SEGINI,NOMID
  434.  
  435.           j1 = 1
  436.           j2 = j1 + n_o_c
  437.           j3 = j2 + n_o_c
  438.           n_o_c = n_o_c - 1
  439.           IF (IFOUR.EQ.-2 .OR. IFOUR.EQ.-1) THEN
  440.             DO i = 0, n_o_c
  441. c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'UX_HC_',i
  442. c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'UY_HC_',i
  443.               WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'UXC',i,'    '
  444.               WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'UYC',i,'    '
  445.             END DO
  446.           ELSE IF (IFOUR.EQ.2) THEN
  447.             DO i = 0, n_o_c
  448. c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'UX_HC_',i
  449. c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'UY_HC_',i
  450. c***            WRITE(LESOBL(j3+i),'(A6,I2.2)') 'UZ_HC_',i
  451.               WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'UXC',i,'    '
  452.               WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'UYC',i,'    '
  453.               WRITE(LESOBL(j3+i),'(A3,I1.1,A4)') 'UZC',i,'    '
  454.             END DO
  455.           ELSE
  456.             write(ioimp,*) 'IDPRIM - HHO - IFOUR not implemented'
  457.             CALL ERREUR(5)
  458.             RETURN
  459.           END IF
  460.  
  461.           j1 = n_d_c + 1
  462.           j2 = j1 + n_o_f
  463.           j3 = j2 + n_o_f
  464.           n_o_f = n_o_f - 1
  465.           IF (IFOUR.EQ.-2 .OR. IFOUR.EQ.-1) THEN
  466.             DO i = 0, n_o_f
  467. c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'UX_HF_',i
  468. c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'UY_HF_',i
  469.               WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'UXF',i,'    '
  470.               WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'UYF',i,'    '
  471.             END DO
  472.           ELSE IF (IFOUR.EQ.2) THEN
  473.             DO i = 0, n_o_f
  474. c***            WRITE(LESOBL(j1+i),'(A6,I2.2)') 'UX_HF_',i
  475. c***            WRITE(LESOBL(j2+i),'(A6,I2.2)') 'UY_HF_',i
  476. c***            WRITE(LESOBL(j3+i),'(A6,I2.2)') 'UZ_HF_',i
  477.               WRITE(LESOBL(j1+i),'(A3,I1.1,A4)') 'UXF',i,'    '
  478.               WRITE(LESOBL(j2+i),'(A3,I1.1,A4)') 'UYF',i,'    '
  479.               WRITE(LESOBL(j3+i),'(A3,I1.1,A4)') 'UZF',i,'    '
  480.             END DO
  481.           END IF
  482.         ENDIF
  483. C     =================================================================
  484. C     FORMULATION LIQUIDE
  485. C     =================================================================
  486.       ELSE IF (MFR2.EQ.11) THEN
  487. C
  488. C       Elements LIQUIDE
  489. C       ================
  490.         IF (MFR.EQ.11) THEN
  491.           NBROBL=2
  492.           SEGINI,NOMID
  493.           LESOBL(1)='P   '
  494.           LESOBL(2)='PI  '
  495. C
  496. C       Elements TUYAU ACOUSTIQUE PUR
  497. C       =============================
  498.         ELSE IF (MFR.EQ.41) THEN
  499.           NBROBL=2
  500.           SEGINI,NOMID
  501.           LESOBL(1)='PI  '
  502.           LESOBL(2)='P   '
  503. C
  504. C       Elements SURFACE LIBRE 
  505. C       ======================
  506.         ELSE IF (MFR.EQ.23) THEN
  507.           NBROBL=3
  508.           SEGINI,NOMID
  509.           LESOBL(1)='P   '
  510.           LESOBL(2)='PI  '
  511.           LESOBL(3)='UZ  '
  512.         ENDIF
  513. C     =================================================================
  514. C     FORMULATION MECANIQUE+LIQUID
  515. C     =================================================================
  516.       ELSE IF (MFR2.EQ.44) THEN
  517. C
  518. C       Element de RACCORD LITU
  519. C       =======================
  520.         IF (MFR.EQ.43) THEN
  521.           NBROBL=5
  522.           SEGINI,NOMID
  523.           LESOBL(1)='UX  '
  524.           LESOBL(2)='UY  '
  525.           LESOBL(3)='UZ  '
  526.           LESOBL(4)='PI  '
  527.           LESOBL(5)='P   '
  528. C
  529. C       Element de RACCORD
  530. C       ==================
  531.         ELSE IF (MFR.EQ.19.OR.MFR.EQ.21) THEN
  532.           NBROBL=2
  533.           SEGINI,NOMID
  534.           LESOBL(1)='P   '
  535.           LESOBL(2)='PI  '
  536. C
  537. C       Element de RACCORD MASSIF (2e serie de composantes)
  538. C       ====================================================
  539.         ELSE IF (MFR.EQ.1019) THEN
  540.           IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  541.             NBROBL=2
  542.             SEGINI,NOMID
  543.             LESOBL(1)='UX  '
  544.             LESOBL(2)='UY  '
  545.           ELSE IF (IFOUR.EQ.0) THEN
  546.             NBROBL=2
  547.             SEGINI,NOMID
  548.             LESOBL(1)='UR  '
  549.             LESOBL(2)='UZ  '
  550.           ELSE IF (IFOUR.EQ.1) THEN
  551.             NBROBL=3
  552.             SEGINI,NOMID
  553.             LESOBL(1)='UR  '
  554.             LESOBL(2)='UZ  '
  555.             LESOBL(3)='UT  '
  556.           ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
  557.             NBROBL=3
  558.             SEGINI,NOMID
  559.             LESOBL(1)='UX  '
  560.             LESOBL(2)='UY  '
  561.             LESOBL(3)='UZ  '
  562.           ENDIF
  563. C
  564. C       Element de RACCORD COQUE (2e serie de composantes)
  565. C       ==================================================
  566.         ELSE IF (MFR.EQ.1021) THEN
  567.           IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  568.             NBROBL=3
  569.             SEGINI,NOMID
  570.             LESOBL(1)='UX  '
  571.             LESOBL(2)='UY  '
  572.             LESOBL(3)='RZ  '
  573.           ELSE IF (IFOUR.EQ.0) THEN
  574.             NBROBL=3
  575.             SEGINI,NOMID
  576.             LESOBL(1)='UR  '
  577.             LESOBL(2)='UZ  '
  578.             LESOBL(3)='RT  '
  579.           ELSE IF (IFOUR.EQ.1) THEN
  580.             NBROBL=4
  581.             SEGINI,NOMID
  582.             LESOBL(1)='UR  '
  583.             LESOBL(2)='UZ  '
  584.             LESOBL(3)='UT  '
  585.             LESOBL(4)='RT  '
  586.           ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
  587.             NBROBL=6
  588.             SEGINI,NOMID
  589.             LESOBL(1)='UX  '
  590.             LESOBL(2)='UY  '
  591.             LESOBL(3)='UZ  '
  592.             LESOBL(4)='RX  '
  593.             LESOBL(5)='RY  '
  594.             LESOBL(6)='RZ  '
  595.           ENDIF
  596.         ENDIF
  597. C     =================================================================
  598. C     FORMULATION POREUX
  599. C     =================================================================
  600.       ELSE IF (MFR2.EQ.33) THEN
  601. C
  602. C       Element POREUX
  603. C       ==============
  604.         IF (MFR.EQ.33) THEN
  605.           IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  606.             NBROBL=3
  607.             SEGINI,NOMID
  608.             LESOBL(1)='UX  '
  609.             LESOBL(2)='UY  '
  610.             LESOBL(3)='P   '
  611.           ELSE IF (IFOUR.EQ.0) THEN
  612.             NBROBL=3
  613.             SEGINI,NOMID
  614.             LESOBL(1)='UR  '
  615.             LESOBL(2)='UZ  '
  616.             LESOBL(3)='P   '
  617.           ELSE IF (IFOUR.EQ.1) THEN
  618.             NBROBL=4
  619.             SEGINI,NOMID
  620.             LESOBL(1)='UR  '
  621.             LESOBL(2)='UZ  '
  622.             LESOBL(3)='UT  '
  623.             LESOBL(4)='P   '
  624.           ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
  625.             NBROBL=4
  626.             SEGINI,NOMID
  627.             LESOBL(1)='UX  '
  628.             LESOBL(2)='UY  '
  629.             LESOBL(3)='UZ  '
  630.             LESOBL(4)='P   '
  631.           ENDIF
  632. C
  633. C       Element POREUX type Q
  634. C       =====================
  635.         ELSE IF (MFR.EQ.57) THEN
  636.           IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  637.             NBROBL=4
  638.             SEGINI,NOMID
  639.             LESOBL(1)='UX  '
  640.             LESOBL(2)='UY  '
  641.             LESOBL(3)='P   '
  642.             LESOBL(4)='PQ  '
  643.           ELSE IF (IFOUR.EQ.0) THEN
  644.             NBROBL=4
  645.             SEGINI,NOMID
  646.             LESOBL(1)='UR  '
  647.             LESOBL(2)='UZ  '
  648.             LESOBL(3)='P   '
  649.             LESOBL(4)='PQ  '
  650.           ELSE IF (IFOUR.EQ.1) THEN
  651.             NBROBL=5
  652.             SEGINI,NOMID
  653.             LESOBL(1)='UR  '
  654.             LESOBL(2)='UZ  '
  655.             LESOBL(3)='UT  '
  656.             LESOBL(4)='P   '
  657.             LESOBL(5)='PQ  '
  658.           ELSE IF (IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
  659.             NBROBL=5
  660.             SEGINI,NOMID
  661.             LESOBL(1)='UX  '
  662.             LESOBL(2)='UY  '
  663.             LESOBL(3)='UZ  '
  664.             LESOBL(4)='P   '
  665.             LESOBL(5)='PQ  '
  666.           ENDIF
  667. C
  668. C       Element POREUX type R
  669. C       =====================
  670.         ELSE IF (MFR.EQ.59) THEN
  671.           IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  672.             NBROBL=5
  673.             SEGINI,NOMID
  674.             LESOBL(1)='UX  '
  675.             LESOBL(2)='UY  '
  676.             LESOBL(3)='P   '
  677.             LESOBL(4)='PQ  '
  678.             LESOBL(5)='TP  '
  679.           ELSE IF (IFOUR.EQ.0) THEN
  680.             NBROBL=5
  681.             SEGINI,NOMID
  682.             LESOBL(1)='UR  '
  683.             LESOBL(2)='UZ  '
  684.             LESOBL(3)='P   '
  685.             LESOBL(4)='PQ  '
  686.             LESOBL(5)='TP  '
  687.           ELSE IF (IFOUR.EQ.1) THEN
  688.             NBROBL=6
  689.             SEGINI,NOMID
  690.             LESOBL(1)='UR  '
  691.             LESOBL(2)='UZ  '
  692.             LESOBL(3)='UT  '
  693.             LESOBL(4)='P   '
  694.             LESOBL(5)='PQ  '
  695.             LESOBL(6)='TP  '
  696.           ELSE IF(IFOUR.EQ.2.OR.IFOUR.EQ.-3) THEN
  697.             NBROBL=6
  698.             SEGINI,NOMID
  699.             LESOBL(1)='UX  '
  700.             LESOBL(2)='UY  '
  701.             LESOBL(3)='UZ  '
  702.             LESOBL(4)='P   '
  703.             LESOBL(5)='PQ  '
  704.             LESOBL(6)='TP  '
  705.           ENDIF
  706.         ENDIF
  707. C     =================================================================
  708. C     FORMULATION ELECTROSTATIQUE
  709. C     =================================================================
  710.       ELSE IF (MFR2.EQ.71) THEN
  711.         NBROBL=1
  712.         SEGINI,NOMID
  713.         LESOBL(1)='VEL     '
  714. C     =================================================================
  715. C     FORMULATION THERMIQUE
  716. C     =================================================================
  717.       ELSE IF (MFR2.EQ.29) THEN
  718. C
  719. C       Elements COQUE
  720. C       ==============
  721.         IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  722.           NPINT=infmod(1)
  723.           IF(NPINT.EQ.0) THEN
  724.              NBROBL=3
  725.              SEGINI NOMID
  726.              LESOBL(1)='TINF    '
  727.              LESOBL(2)='T       '
  728.              LESOBL(3)='TSUP    '
  729.           ELSE
  730.              NBROBL = 1
  731.              SEGINI NOMID
  732.              LESOBL(1)='T       '
  733.           ENDIF
  734. C
  735. C       Autres elements
  736. C       ===============
  737.         ELSE
  738.           NBROBL=1
  739.           SEGINI NOMID
  740.           LESOBL(1)='T       '
  741.         ENDIF
  742. C     =================================================================
  743. C     FORMULATION DIFFUSION
  744. C     =================================================================
  745.       ELSE IF (MFR2.EQ.73) THEN
  746. C
  747. C       Recuperation du LISTMOTS dans IVAMOD(1)
  748.         MLMOT1=IVAMOD(1)
  749.  
  750. C       Recuperation de l'inconnue PRIMALE
  751.         CCOMP =MLMOT1.MOTS(1)
  752.         NBCHAR=LONG(CCOMP)
  753.         IF (NBCHAR.GT.LOCOMP) THEN
  754.           CALL ERREUR(536)
  755.           RETURN
  756.         ENDIF
  757. C
  758. C       Elements COQUE
  759. C       ==============
  760.         IF (MFR.EQ.3 .OR. MFR.EQ.5 .OR. MFR.EQ.9) THEN
  761.           NPINT=infmod(1)
  762.           IF(NPINT.EQ.0) THEN
  763.              NBROBL=3
  764.              SEGINI NOMID
  765.              LESOBL(1)=CCOMP(1:NBCHAR)//'IN     '
  766.              LESOBL(2)=CCOMP
  767.              LESOBL(3)=CCOMP(1:NBCHAR)//'SU     '
  768.           ELSE
  769.              NBROBL = 1
  770.              SEGINI NOMID
  771.              LESOBL(1)=CCOMP
  772.           ENDIF
  773. C
  774. C       Autres elements
  775. C       ===============
  776.         ELSE
  777.           NBROBL = 1
  778.           SEGINI NOMID
  779.           LESOBL(1)=CCOMP
  780.         ENDIF
  781. C     =================================================================
  782. C     FORMULATION CHANGEMENT_PHASE
  783. C     =================================================================
  784.       ELSE IF (MFR2.EQ.30) THEN
  785. C
  786.         IF (IMODEL.CMATEE.EQ.'CHPH_PAR') THEN
  787.           NBROBL=1
  788.           NBRFAC=0
  789.           SEGINI,NOMID
  790.           MLMOT1=IMODEL.IVAMOD(1)
  791.           NOMID.LESOBL(1)=MLMOT1.MOTS(1)
  792.         ELSE IF  (IMODEL.CMATEE.EQ.'CHPH_SOL')THEN
  793.           NBROBL=2
  794.           NBRFAC=0
  795.           SEGINI,NOMID
  796.           MLMOT1=IMODEL.IVAMOD(1)
  797.           NOMID.LESOBL(1)=MLMOT1.MOTS(1)
  798.           NOMID.LESOBL(2)=MLMOT1.MOTS(2)
  799.         ENDIF
  800. C     =================================================================
  801.       ENDIF
  802. C        
  803.       IF (NOMID.NE.0) THEN
  804.         if (ifomod.eq.6) then
  805.           nbrfa0 = nbrfac
  806.           NBRFAC = NBROBL + (nbrfa0*2)
  807.           segadj nomid
  808.           do imo = 1,nbrobl
  809.            lesfac(nbrfa0 + imo)(2:4) = lesobl(imo)(1:3)
  810.            lesfac(nbrfa0 + imo)(1:1) = 'I'
  811.           enddo
  812.           do imo = 1,nbrfa0
  813.            lesfac(nbrfa0+nbrobl+imo)(2:4) = lesfac(imo)(1:3)
  814.            lesfac(nbrfa0+nbrobl+imo)(1:1) = 'I'
  815.           enddo
  816.         endif
  817.       ENDIF
  818. C
  819.       IF (NOMID.NE.0) SEGACT,NOMID*NOMOD
  820.       IPNOMC=NOMID
  821.       END
  822.  
  823.  
  824.  
  825.  

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