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

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