Télécharger la plaquette Cast3M


fr en

Télécharger idcara.eso

Retour à la liste

Numérotation des lignes : 

idcara

  1. C IDCARA    SOURCE    OF166741  24/05/06    21:15:15     11082          
  2.       SUBROUTINE IDCARA(IPMODE,MFR0,IPNOMC,NBROBL,NBRFAC)
  3. *--------------------------------------------------------------------*
  4. *             RECHERCHE DES NOMS DE CARACTERISTIQUES                 *
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *  ENTREES:                                                          *
  8. *                                                                    *
  9. *    IPMODE    Pointeur sur un MMODEL.KMODEL                         *
  10. *    MFR0      Numero de Formulation                                 *
  11. *      - Sert seulement si different de celui calcule avec IMODEL    *
  12. *                                                                    *
  13. *  SORTIES:                                                          *
  14. *                                                                    *
  15. *     IPNOMC   Pointeur sur les tables de noms de composantes        *
  16. *              obligatoires et facultatives                          *
  17. *     NBROBL   leur nombre  ( =0 si pas trouve )                     *
  18. *     NBRFAC   leur nombre ( =0 si pas trouve )                      *
  19. *                                                                    *
  20. *--------------------------------------------------------------------*
  21. *
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. C==DEB= FORMULATION HHO == Include specifique ==========================
  28. -INC CCHHOPA
  29. C==FIN= FORMULATION HHO ================================================
  30.  
  31. -INC SMMODEL
  32.  
  33.       CHARACTER*16 NOM16
  34.  
  35.       NOMID =0
  36.       NBROBL=0
  37.       NBRFAC=0
  38.       IMODEL=IPMODE
  39. C     On suppose que le IMODEL est actif
  40. C      SEGACT,IMODEL
  41. C     Recuperation de IFOUR dans CCOPTIO.INC
  42.       IFOU  = IFOUR
  43.       MELE  = NEFMOD
  44.       MFR   = NUMMFR(MELE)
  45.  
  46.       NOMID = IMODEL.LNOMID(7)
  47. C     S'ils sont deja presents dans le IMODEL, on ne les refait pas...
  48.       IF(NOMID .NE. 0 .AND. (MFR .EQ. MFR0))THEN
  49.         SEGACT,NOMID
  50.         NBROBL=LESOBL(/2)
  51.         NBRFAC=LESFAC(/2)
  52.         IPNOMC = NOMID
  53.         RETURN
  54.       ENDIF
  55.  
  56.       do im = 1,matmod(/2)
  57.         if (matmod(im).eq.'IMPEDANCE') then
  58.           RETURN
  59.         endif
  60.       enddo
  61.  
  62. C     Sinon on les determine
  63.       MFR = MFR0
  64. C=DEB== FORMULATION HHO === HHO = MECANIQUE + MASSIF ===================
  65.       IF (MFR0 .EQ. HHO_MFR_ELEMENT) MFR = 1
  66. C=FIN== FORMULATION HHO ================================================
  67.  
  68. C     Cas un peu particulier de la THERMIQUE et de la DIFFUSION
  69.       NOM16=FORMOD(1)
  70.       IF(NOM16 .EQ. 'THERMIQUE       ') GOTO 1001
  71.       IF(NOM16 .EQ. 'DIFFUSION       ') GOTO 1002
  72.  
  73.       IF (MFR  .EQ.1  .OR. MFR  .EQ.45) GOTO 1003
  74.       IF (IFOUR.LT.-3 .OR. IFOUR.GT.2 ) GOTO 1003
  75. *
  76. *     ELEMENTS  CIFL   MACRO ELEMENT CISAILLEMENT FLEXION
  77. *
  78.       IF (MELE.EQ.258)THEN
  79.         IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
  80.           NBROBL=2
  81.           SEGINI NOMID
  82.           LESOBL(1)= 'SECT'
  83.           LESOBL(2)= 'INRZ'
  84.         ENDIF
  85.       ENDIF
  86. *
  87. *     COQUE MINCE OU CISAILLEMENT TRANSVERSE
  88. *
  89.       IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  90.          NBROBL=1
  91.          NBRFAC=2
  92.          SEGINI NOMID
  93.          LESOBL(1)='EPAI'
  94.          LESFAC(1)='CALF'
  95.          LESFAC(2)='EXCE'
  96. *
  97. *     COQUE EPAISSE
  98. *
  99.       ELSE IF (MFR.EQ.5) THEN
  100.          NBROBL=1
  101.          NBRFAC=1
  102.          SEGINI NOMID
  103.          LESOBL(1)='EPAI'
  104.          LESFAC(1)='EXCE'
  105. *
  106. *     POUTRES TRIDIM
  107. *
  108.       ELSE IF (MFR.EQ.7) THEN
  109.          IF (IFOUR.EQ.2) THEN
  110.             NBRFAC=10
  111.             NBROBL=4
  112.             SEGINI NOMID
  113.             LESOBL(1)= 'TORS'
  114.             LESOBL(2)= 'INRY'
  115.             LESOBL(3)= 'INRZ'
  116.             LESOBL(4)= 'SECT'
  117.             LESFAC(1)= 'SECY'
  118.             LESFAC(2)= 'SECZ'
  119.             LESFAC(3)= 'DX  '
  120.             LESFAC(4)= 'DY  '
  121.             LESFAC(5)= 'DZ  '
  122.             LESFAC(6)= 'OMEG'
  123.             LESFAC(7)= 'VECT'
  124.             LESFAC(8)= 'VX  '
  125.             LESFAC(9)= 'VY  '
  126.             LESFAC(10)= 'VZ  '
  127. *
  128. *     POUTRES 2D
  129.          ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  130.             NBRFAC=2
  131.             NBROBL=2
  132.             SEGINI NOMID
  133.             LESOBL(1)= 'SECT'
  134.             LESOBL(2)= 'INRZ'
  135.             LESFAC(1)= 'SECY'
  136.             LESFAC(2)= 'DY  '
  137. *
  138.          ENDIF
  139. *
  140. *      LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS
  141. *
  142.       ELSE IF (MFR.EQ.51) THEN
  143.             NBROBL=9
  144.             SEGINI NOMID
  145.             LESOBL(1)='RLUX'
  146.             LESOBL(2)='RLUY'
  147.             LESOBL(3)='RLUZ'
  148.             LESOBL(4)='RLRX'
  149.             LESOBL(5)='RLRY'
  150.             LESOBL(6)='RLRZ'
  151.             LESOBL(7)='VX  '
  152.             LESOBL(8)='VY  '
  153.             LESOBL(9)='VZ  '
  154.  
  155. *
  156. *     BAEX : BARRE EXCENTRE
  157. *
  158.       ELSE IF (MFR.EQ.49) THEN
  159.            NBROBL=6
  160.            SEGINI NOMID
  161.            LESOBL(1)='SECT'
  162.            LESOBL(2)='EXCZ'
  163.            LESOBL(3)='EXCY'
  164.            LESOBL(4)='VX  '
  165.            LESOBL(5)='VY  '
  166.            LESOBL(6)='VZ  '
  167. *
  168. *     TUYAU ACOUSTIQUE PURE
  169. *
  170.       ELSE IF (MFR.EQ.41) THEN
  171.             NBROBL=1
  172.             NBRFAC=1
  173.             SEGINI NOMID
  174.             LESOBL(1)='RAYO'
  175.             LESFAC(1)='RACO'
  176. *
  177. *     TUYAU  TRIDIM
  178. *
  179.       ELSE IF (MFR.EQ.13) THEN
  180.          IF (IFOUR.EQ.2) THEN
  181.             NBROBL=2
  182.             NBRFAC=13 
  183.             SEGINI NOMID
  184.             LESOBL(1)='EPAI'
  185.             LESOBL(2)='RAYO'
  186.             LESFAC(1)='RACO'
  187.             LESFAC(2)='PRES'
  188.             LESFAC(3)='CISA'
  189.             LESFAC(4)='CFFX'
  190.             LESFAC(5)='CFMX'
  191.             LESFAC(6)='CFMY'
  192.             LESFAC(7)='CFMZ'
  193.             LESFAC(8)='CFPR'
  194.             LESFAC(9)= 'OMEG'
  195.             LESFAC(10)='VECT'
  196.             LESFAC(11)='VX  '
  197.             LESFAC(12)='VY  '
  198.             LESFAC(13)='VZ  '
  199.          ENDIF
  200. *
  201. *     TUYO
  202. *
  203.       ELSE IF (MFR.EQ.39) THEN
  204.          IF (IFOUR.EQ.2) THEN
  205.             NBROBL=2
  206.             NBRFAC=6
  207.             SEGINI NOMID
  208.             LESOBL(1)='EPAI'
  209.             LESOBL(2)='RAYO'
  210.             LESFAC(1)='RACO'
  211.             LESFAC(2)='PRES'
  212.             LESFAC(3)='VECT'
  213.             LESFAC(4)='VX  '
  214.             LESFAC(5)='VY  '
  215.             LESFAC(6)='VZ  '
  216.          ENDIF
  217. *
  218. *     LINESPRING
  219. *
  220.       ELSE IF (MFR.EQ.15) THEN
  221.          IF (IFOUR.EQ.2) THEN
  222.             NBROBL=5
  223.             SEGINI NOMID
  224.             LESOBL(1)='EPAI'
  225.             LESOBL(2)='FISS'
  226.             LESOBL(3)='VX  '
  227.             LESOBL(4)='VY  '
  228.             LESOBL(5)='VZ  '
  229.          ENDIF
  230. *
  231. *     TUYAU FISSURE
  232. *
  233.       ELSE IF (MFR.EQ.17) THEN
  234.          IF (IFOUR.EQ.2) THEN
  235.             NBROBL=9
  236.             SEGINI NOMID
  237. c            LESOBL(1)='RAYO'
  238. c            LESOBL(2)='EPAI'
  239. c            LESOBL(3)='ANGL'
  240. c            LESOBL(4)='VX  '
  241. c            LESOBL(5)='VY  '
  242. c            LESOBL(6)='VZ  '
  243. c            LESOBL(7)='VXF '
  244. c            LESOBL(8)='VYF '
  245. c            LESOBL(9)='VZF '
  246.             LESOBL(1)='RAYO'
  247.             LESOBL(2)='EPAI'
  248.             LESOBL(3)='VX  '
  249.             LESOBL(4)='VY  '
  250.             LESOBL(5)='VZ  '
  251.             LESOBL(6)='VXF '
  252.             LESOBL(7)='VYF '
  253.             LESOBL(8)='VZF '
  254.             LESOBL(9)='ANGL'
  255.          ENDIF
  256. *
  257. *     BARRE or COS2
  258. *
  259.       ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  260.          NBROBL=1
  261.          SEGINI NOMID
  262.          LESOBL(1)='SECT'
  263. *
  264. *     ELEMENT HOMOGENE
  265. *
  266.       ELSE IF (MFR.EQ.37) THEN
  267.         IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN
  268.             NBROBL=5
  269.             SEGINI NOMID
  270.             LESOBL(1)='SCEL'
  271.             LESOBL(2)='SFLU'
  272.             LESOBL(3)='EPS '
  273.             LESOBL(4)='SECT'
  274.             LESOBL(5)='INRZ'
  275.         ELSE
  276.          NBROBL=3
  277.          NBRFAC=2
  278.          SEGINI NOMID
  279.          LESOBL(1)='SCEL'
  280.          LESOBL(2)='SFLU'
  281.          LESOBL(3)='EPS '
  282.          LESFAC(1)='NOF1'
  283.          LESFAC(2)='NOF2'
  284.         ENDIF
  285. *
  286. *     RACCORD LIQUIDE TUYAU
  287. *
  288.       ELSE IF (MFR.EQ.43) THEN
  289.             NBROBL=1
  290.             NBRFAC=5
  291.             SEGINI NOMID
  292.             LESOBL(1)='RAYO'
  293.             LESFAC(1)='RACO'
  294.             LESFAC(2)='VECT'
  295.             LESFAC(3)='VX  '
  296.             LESFAC(4)='VY  '
  297.             LESFAC(5)='VZ  '
  298. *
  299. *     ELEMENTS DE SECTION
  300. *
  301.       ELSE IF (MFR.EQ.47) THEN
  302.          IF (IFOUR.EQ.2) THEN
  303.             NBROBL=2
  304.             SEGINI NOMID
  305.             LESOBL(1)='ALPY'
  306.             LESOBL(2)='ALPZ'
  307.          ELSE
  308.             NBROBL=1
  309.             NBRFAC=0
  310.             SEGINI NOMID
  311.             LESOBL(1)='ALPY'
  312.          ENDIF
  313. C
  314. *     caracteristique supplementaire pour le SEGS
  315.          IF(MELE.EQ.166)THEN
  316.             NBROBL=NBROBL+1
  317.             SEGADJ,NOMID
  318.             LESOBL(NBROBL)='LARG'
  319.          ENDIF
  320. *     caracteristique supplementaire pour le POJS
  321.          IF(MELE.EQ.167)THEN
  322.             NBROBL=NBROBL+1
  323.             SEGADJ,NOMID
  324.             LESOBL(NBROBL)='SECT'
  325.          ENDIF
  326. C
  327. *
  328. *     JOINTS GENERALISE
  329. *
  330.       ELSE IF (MFR.EQ.55) THEN
  331. CcPPj    NBROBL=1
  332. CcPPj    NBRFAC=0
  333. CcPPj    SEGINI NOMID
  334. CcPPj    LESOBL(1)='EPAI'
  335.          NBROBL=0
  336.          NBRFAC=1
  337.          SEGINI NOMID
  338.          LESFAC(1)='EPAI'
  339. *
  340. *      LIQUIDE 
  341. *
  342.       ELSE IF (MFR.EQ.11.OR.MFR.EQ.19.OR.MFR.EQ.21) THEN
  343.          IF (IFOUR.EQ.2) THEN
  344.             NBROBL=0
  345.             NBRFAC=3
  346.             SEGINI NOMID
  347.             LESFAC(1)='VX  '
  348.             LESFAC(2)='VY  '
  349.             LESFAC(3)='VZ  '
  350.  
  351.          ELSE
  352.             NBROBL=0
  353.             NBRFAC=2
  354.             SEGINI NOMID
  355.             LESFAC(1)='VX  '
  356.             LESFAC(2)='VY  '
  357.          ENDIF
  358. *
  359.       ENDIF
  360.  
  361. C     write(6,*) 'MFR =',MFR
  362.  
  363.  
  364. C  Par DEFAUT : segment VIDE
  365. C ===========================
  366.       IF (NOMID.EQ.0) THEN
  367.         SEGINI,NOMID
  368.       ELSE
  369.         if (ifomod.eq.6) then
  370.           nbrfa0 = nbrfac
  371.           NBRFAC = NBROBL + (nbrfa0*2)
  372.           segadj nomid
  373.           do imo = 1,nbrobl
  374.            lesfac(nbrfa0 + imo)(2:4) = lesobl(imo)(1:3)
  375.            lesfac(nbrfa0 + imo)(1:1) = 'I'
  376.           enddo
  377.           do imo = 1,nbrfa0
  378.            lesfac(nbrfa0+nbrobl+imo)(2:4) = lesfac(imo)(1:3)
  379.            lesfac(nbrfa0+nbrobl+imo)(1:1) = 'I'
  380.           enddo
  381.         endif
  382.       ENDIF
  383.  
  384.       SEGACT,NOMID*NOMOD
  385.       IPNOMC=NOMID
  386.       RETURN
  387.  
  388.  
  389. C     Formulation THERMIQUE
  390. C ===========================
  391. 1001  CONTINUE
  392.       IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  393. C       TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  394.         NBROBL=1
  395.         SEGINI NOMID
  396.         LESOBL(1)= 'SECT'
  397.  
  398.       ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  399. C       COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  400.            NBROBL=1
  401.            NBRFAC=1
  402.            SEGINI NOMID
  403.            LESOBL(1)='EPAI    '
  404.            LESFAC(1)='EXCE    '
  405.  
  406.       ELSE
  407. C       MASSIF pour CONDUCTION
  408.         NBROBL=0
  409.         SEGINI NOMID
  410.       ENDIF
  411.       SEGACT,NOMID*NOMOD
  412.       IPNOMC=NOMID
  413.       RETURN
  414.  
  415. C     Formulation DIFFUSION
  416. C ===========================
  417. 1002  CONTINUE
  418.       IF(MFR.EQ.79 .OR. MFR.EQ.27) then
  419. C       TUY2, TUY3 pour ADVECTION ou BARR pour CONDUCTION
  420.         NBROBL=1
  421.         SEGINI NOMID
  422.         LESOBL(1)= 'SECT'
  423.  
  424.       ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  425. C       COQ3,COQ4,COQ6,COQ8 pour CONDUCTION
  426.            NBROBL=1
  427.            NBRFAC=1
  428.            SEGINI NOMID
  429.            LESOBL(1)='EPAI    '
  430.            LESFAC(1)='EXCE    '
  431.  
  432.       ELSE
  433. C       MASSIF pour CONDUCTION
  434.         NBROBL=0
  435.         SEGINI NOMID
  436.       ENDIF
  437.       SEGACT,NOMID*NOMOD
  438.       IPNOMC=NOMID
  439.       RETURN
  440.  
  441.  1003 CONTINUE
  442. C     ajout de la densite (rendement) vectorielle du constituant kich
  443.       IF (NOMID.EQ.0) SEGINI NOMID
  444.  
  445.        ifac = nbrfac
  446.        NBRFAC= nbrfac + 10
  447.        segadj nomid
  448.        lesfac(ifac + 1) = 'REND'
  449.        lesfac(ifac + 2) = 'W1X '
  450.        lesfac(ifac + 3) = 'W1Y '
  451.        lesfac(ifac + 4) = 'W1Z '
  452.        lesfac(ifac + 5) = 'W2X '
  453.        lesfac(ifac + 6) = 'W2Y '
  454.        lesfac(ifac + 7) = 'W2Z '
  455.        lesfac(ifac + 8) = 'REN1'
  456.        lesfac(ifac + 9) = 'REN2'
  457.        lesfac(ifac + 10)= 'REN3'
  458.       SEGACT,NOMID*NOMOD
  459.       IPNOMC=NOMID
  460.       RETURN
  461.  
  462.       END
  463.  
  464.  
  465.  

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