Télécharger la plaquette Cast3M


fr en

Télécharger idcarb.eso

Retour à la liste

Numérotation des lignes : 

idcarb

  1. C IDCARB    SOURCE    CB215821  24/04/08    21:15:02     11895          
  2.       SUBROUTINE IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC)
  3. *--------------------------------------------------------------------*
  4. *             RECHERCHE DES NOMS DE CARACTERISTIQUES                 *
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *  ENTREES:                                                          *
  8. *                                                                    *
  9. *     MELE     numero de l'element                                   *
  10. *     IFOUR    issu de CCOPTIO                                       *
  11. *                                                                    *
  12. *  SORTIES:                                                          *
  13. *                                                                    *
  14. *     IPNOMC   Pointeur sur les tables de noms de composantes        *
  15. *              obligatoires et facultatives                          *
  16. *     NBROBL   leur nombre  ( =0 si pas trouve )                     *
  17. *     NBRFAC   leur nombre ( =0 si pas trouve )                      *
  18. *                                                                    *
  19. *--------------------------------------------------------------------*
  20. *
  21.       IMPLICIT INTEGER(I-N)
  22.       SEGMENT NOMID
  23.         CHARACTER*8 LESOBL(NBROBL),LESFAC(NBRFAC)
  24.       ENDSEGMENT
  25. *
  26.       MFR=NUMMFR(MELE)
  27.       NBROBL = 0
  28.       NBRFAC = 0
  29.       NOMID=0
  30.       IF (MFR.EQ.1.OR.MFR.EQ.45) GOTO 9999
  31.       IF (IFOUR.LT.-3.OR.IFOUR.GT.2) GOTO 9999
  32. *
  33. *    element uy2 et ty3 pour advection
  34. *
  35.       IF(MELE.EQ.269.or.mele.eq.270) then
  36.         NBROBL=1
  37.         SEGINI NOMID
  38.         LESOBL(1)= 'SECT'
  39.       ENDIF
  40. *
  41. *     ELEMENTS  CIFL   MACRO ELEMENT CISAILLEMENT FLEXION
  42. *
  43.       IF (MELE.EQ.258)THEN
  44.         IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  45.           NBROBL=2
  46.           SEGINI NOMID
  47.           LESOBL(1)= 'SECT'
  48.           LESOBL(2)= 'INRZ'
  49.         ENDIF
  50.       ENDIF
  51. *
  52. *     COQUE MINCE OU CISAILLEMENT TRANSVERSE
  53. *
  54.       IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  55.          NBROBL=1
  56.          NBRFAC=2
  57.          SEGINI NOMID
  58.          LESOBL(1)='EPAI'
  59.          LESFAC(1)='CALF'
  60.          LESFAC(2)='EXCE'
  61. *
  62. *     COQUE EPAISSE
  63. *
  64.       ELSE IF (MFR.EQ.5) THEN
  65.          NBROBL=1
  66.          NBRFAC=1
  67.          SEGINI NOMID
  68.          LESOBL(1)='EPAI'
  69.          LESFAC(1)='EXCE'
  70. *
  71. *     POUTRES TRIDIM
  72. *
  73.       ELSE IF (MFR.EQ.7) THEN
  74.          IF (IFOUR.EQ.2) THEN
  75.             NBRFAC=9 
  76.             NBROBL=4
  77.             SEGINI NOMID
  78.             LESOBL(1)= 'TORS'
  79.             LESOBL(2)= 'INRY'
  80.             LESOBL(3)= 'INRZ'
  81.             LESOBL(4)= 'SECT'
  82.             LESFAC(1)= 'SECY'
  83.             LESFAC(2)= 'SECZ'
  84.             LESFAC(3)= 'DX  '
  85.             LESFAC(4)= 'DY  '
  86.             LESFAC(5)= 'DZ  '
  87.             LESFAC(6)= 'OMEG'
  88.             LESFAC(7)= 'VX'
  89.             LESFAC(8)= 'VY'
  90.             LESFAC(9)= 'VZ'
  91. *
  92. *     POUTRES 2D
  93.          ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  94.             NBRFAC=1
  95.             NBROBL=2
  96.             SEGINI NOMID
  97.             LESOBL(1)= 'SECT'
  98.             LESOBL(2)='INRZ'
  99.             LESFAC(1)= 'SECY'
  100. *
  101.          ENDIF
  102. *
  103. *      LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS
  104. *
  105.       ELSE IF (MFR.EQ.51) THEN
  106.             NBROBL=9
  107.             SEGINI NOMID
  108.             LESOBL(1)='RLUX'
  109.             LESOBL(2)='RLUY'
  110.             LESOBL(3)='RLUZ'
  111.             LESOBL(4)='RLRX'
  112.             LESOBL(5)='RLRY'
  113.             LESOBL(6)='RLRZ'
  114.             LESOBL(7)='VX  '
  115.             LESOBL(8)='VY  '
  116.             LESOBL(9)='VZ  '
  117.  
  118. *
  119. *     BAEX : BARRE EXCENTRE
  120. *
  121.       ELSE IF (MFR.EQ.49) THEN
  122.            NBROBL=6
  123.            SEGINI NOMID
  124.            LESOBL(1)='SECT'
  125.            LESOBL(2)='EXCZ'
  126.            LESOBL(3)='EXCY'
  127.            LESOBL(4)='VX  '
  128.            LESOBL(5)='VY  '
  129.            LESOBL(6)='VZ  '
  130. *
  131. *     TUYAU ACOUSTIQUE PURE
  132. *
  133.       ELSE IF (MFR.EQ.41) THEN
  134.             NBROBL=1
  135.             NBRFAC=1
  136.             SEGINI NOMID
  137.             LESOBL(1)='RAYO'
  138.             LESFAC(1)='RACO'
  139. *
  140. *     TUYAU  TRIDIM
  141. *
  142.       ELSE IF (MFR.EQ.13) THEN
  143.          IF (IFOUR.EQ.2) THEN
  144.             NBROBL=2
  145.             NBRFAC=12
  146.             SEGINI NOMID
  147.             LESOBL(1)='EPAI'
  148.             LESOBL(2)='RAYO'
  149.             LESFAC(1)='RACO'
  150.             LESFAC(2)='PRES'
  151.             LESFAC(3)='CISA'
  152.             LESFAC(4)='CFFX'
  153.             LESFAC(5)='CFMX'
  154.             LESFAC(6)='CFMY'
  155.             LESFAC(7)='CFMZ'
  156.             LESFAC(8)='CFPR'
  157.             LESFAC(9)= 'OMEG'
  158.             LESFAC(10)='VX'
  159.             LESFAC(11)='VY'
  160.             LESFAC(12)='VZ'
  161.          ENDIF
  162. *
  163. *     TUYO
  164. *
  165.       ELSE IF (MFR.EQ.39) THEN
  166.          IF (IFOUR.EQ.2) THEN
  167.             NBROBL=2
  168.             NBRFAC=5
  169.             SEGINI NOMID
  170.             LESOBL(1)='EPAI'
  171.             LESOBL(2)='RAYO'
  172.             LESFAC(1)='RACO'
  173.             LESFAC(2)='PRES'
  174.             LESFAC(3)='VX'
  175.             LESFAC(4)='VY'
  176.             LESFAC(5)='VZ'
  177.          ENDIF
  178. *
  179. *     LINESPRING
  180. *
  181.       ELSE IF (MFR.EQ.15) THEN
  182.          IF (IFOUR.EQ.2) THEN
  183.             NBROBL=5
  184.             SEGINI NOMID
  185.             LESOBL(1)='EPAI'
  186.             LESOBL(2)='FISS'
  187.             LESOBL(3)='VX  '
  188.             LESOBL(4)='VY  '
  189.             LESOBL(5)='VZ  '
  190.          ENDIF
  191. *
  192. *     TUYAU FISSURE
  193. *
  194.       ELSE IF (MFR.EQ.17) THEN
  195.          IF (IFOUR.EQ.2) THEN
  196.             NBROBL=9
  197.             SEGINI NOMID
  198. c            LESOBL(1)='RAYO'
  199. c            LESOBL(2)='EPAI'
  200. c            LESOBL(3)='ANGL'
  201. c            LESOBL(4)='VX  '
  202. c            LESOBL(5)='VY  '
  203. c            LESOBL(6)='VZ  '
  204. c            LESOBL(7)='VXF '
  205. c            LESOBL(8)='VYF '
  206. c            LESOBL(9)='VZF '
  207.             LESOBL(1)='RAYO'
  208.             LESOBL(2)='EPAI'
  209.             LESOBL(3)='VX  '
  210.             LESOBL(4)='VY  '
  211.             LESOBL(5)='VZ  '
  212.             LESOBL(6)='VXF '
  213.             LESOBL(7)='VYF '
  214.             LESOBL(8)='VZF '
  215.             LESOBL(9)='ANGL'
  216.          ENDIF
  217. *
  218. *     BARRE or COS2
  219. *
  220.       ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  221.          NBROBL=1
  222.          SEGINI NOMID
  223.          LESOBL(1)='SECT'
  224. *
  225. *     ELEMENT HOMOGENE
  226. *
  227.       ELSE IF (MFR.EQ.37) THEN
  228.         IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  229.             NBROBL=5
  230.             SEGINI NOMID
  231.             LESOBL(1)='SCEL'
  232.             LESOBL(2)='SFLU'
  233.             LESOBL(3)='EPS '
  234.             LESOBL(4)='SECT'
  235.             LESOBL(5)='INRZ'
  236.         ELSE
  237.          NBROBL=3
  238.          NBRFAC=2
  239.          SEGINI NOMID
  240.          LESOBL(1)='SCEL'
  241.          LESOBL(2)='SFLU'
  242.          LESOBL(3)='EPS '
  243.          LESFAC(1)='NOF1'
  244.          LESFAC(2)='NOF2'
  245.         ENDIF
  246. *
  247. *     RACCORD LIQUIDE TUYAU
  248. *
  249.       ELSE IF (MFR.EQ.43) THEN
  250.             NBROBL=1
  251.             NBRFAC=5
  252.             SEGINI NOMID
  253.             LESOBL(1)='RAYO'
  254.             LESFAC(1)='RACO'
  255.             LESFAC(2)='VECT'
  256.             LESFAC(3)='VEC1'
  257.             LESFAC(4)='VEC2'
  258.             LESFAC(5)='VEC3'
  259. *
  260. *     ELEMENTS DE SECTION
  261. *
  262.       ELSE IF (MFR.EQ.47) THEN
  263.          IF (IFOUR.EQ.2) THEN
  264.             NBROBL=2
  265.             SEGINI NOMID
  266.             LESOBL(1)='ALPY'
  267.             LESOBL(2)='ALPZ'
  268.          ELSE
  269.             NBROBL=1
  270.             NBRFAC=0
  271.             SEGINI NOMID
  272.             LESOBL(1)='ALPY'
  273.          ENDIF
  274. C
  275. *     caracteristique supplementaire pour le SEGS
  276.          IF(MELE.EQ.166)THEN
  277.             NBROBL=NBROBL+1
  278.             SEGADJ,NOMID
  279.             LESOBL(NBROBL)='LARG'
  280.          ENDIF
  281. *     caracteristique supplementaire pour le POJS
  282.          IF(MELE.EQ.167)THEN
  283.             NBROBL=NBROBL+1
  284.             SEGADJ,NOMID
  285.             LESOBL(NBROBL)='SECT'
  286.          ENDIF
  287. C
  288. *
  289. *     JOINTS GENERALISE
  290. *
  291.       ELSE IF (MFR.EQ.55) THEN
  292. CcPPj    NBROBL=1
  293. CcPPj    NBRFAC=0
  294. CcPPj    SEGINI NOMID
  295. CcPPj    LESOBL(1)='EPAI'
  296.          NBROBL=0
  297.          NBRFAC=1
  298.          SEGINI NOMID
  299.          LESFAC(1)='EPAI'
  300. *
  301.       ENDIF
  302.  
  303. *
  304.  9999 CONTINUE
  305.       IF (NOMID.EQ.0) SEGINI NOMID
  306.  
  307. * ajout de la densite (rendement) vectorielle du constituant kich
  308.        ifac = nbrfac
  309.        NBRFAC= nbrfac + 10
  310.        segadj nomid
  311.        lesfac(ifac + 1) ='REND'
  312.        lesfac(ifac + 2) ='W1X '
  313.        lesfac(ifac + 3) ='W1Y '
  314.        lesfac(ifac + 4) ='W1Z '
  315.        lesfac(ifac + 5) ='W2X '
  316.        lesfac(ifac + 6) ='W2Y '
  317.        lesfac(ifac + 7) ='W2Z '
  318.        lesfac(ifac + 8) ='REN1'
  319.        lesfac(ifac + 9) ='REN2'
  320.        lesfac(ifac + 10)='REN3'
  321.  
  322.  
  323.       IPNOMC=NOMID
  324.       RETURN
  325.       END
  326.  
  327.  

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