Télécharger la plaquette Cast3M


fr en

Télécharger carmat.eso

Retour à la liste

Numérotation des lignes : 

carmat

  1. C CARMAT    SOURCE    CB215821  24/04/12    21:15:11     11897          
  2.       SUBROUTINE CARMAT(IPMODE,IPCHE1,IPMAIL,MFR,MELE,CMATE,
  3.      1   ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET)
  4. C_______________________________________________________________________
  5. C
  6. C  Entrees:
  7. C  ________
  8. C
  9. C    IPMODE   Pointeur sur un IMODEL
  10. C    IPCHE1   Pointeur sur un MCHAML de caracteristiques
  11. C    IPMAIL   Pointeur sur un maillage elementaire
  12. C    MFR      Formulation de l element fini
  13. C    MELE     Numero de l element fini
  14. C    CMATE    Nom du materiau
  15. C    ISUP5    Critere d existence des caracteristiques
  16. C    INFOS    Tableau d infos
  17. C    CONM     Nom du maillage elementaire
  18. C
  19. C  Sorties:
  20. C  ________
  21. C
  22. C     IMAT  = Pointeur sur un tableau de MELVAL de MATERIAU
  23. C     ICAR  = Pointeur sur un tableau de MELVAL de CARACTERISTIQUES
  24. C     NUMAT = Nombre des composantes de materiau
  25. C     NUCAR = Nombre des composantes des caract. geometriques
  26. C     IRET    1 si tout OK 0 sinon
  27. C
  28. C_______________________________________________________________________
  29. C
  30.       IMPLICIT INTEGER(I-N)
  31.       IMPLICIT REAL*8 (A-H,O-Z)
  32.  
  33. -INC CCHAMP
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37.  
  38. -INC SMCHAML
  39. -INC SMMODEL
  40. -INC CCGEOME
  41.  
  42.       SEGMENT NOTYPE
  43.         CHARACTER*16 TYPE(NBTYPE)
  44.       ENDSEGMENT
  45. *
  46.       SEGMENT MPTVAL
  47.         INTEGER IPOS(NS)    ,NSOF(NS)
  48.         INTEGER      IVAL(NCOSOU)
  49.         CHARACTER*16 TYVAL(NCOSOU)
  50.       ENDSEGMENT
  51. *
  52.       CHARACTER*8 CMATE
  53.       CHARACTER*(NCONCH) CONM
  54.       PARAMETER (NINF=3)
  55.       INTEGER INFOS(NINF)
  56.       LOGICAL lsupma
  57. C
  58.       IRET=1
  59.       IMAT=0
  60.       ICAR=0
  61.       MOCARA=0
  62.       MOMATR=0
  63.       NUMAT=0
  64.       NUCAR=0
  65.       NBTYPE=0
  66.       IPPORE=0
  67.       IF(MFR.EQ.33) IPPORE= NBNNE(NUMGEO(MELE))
  68. C
  69. C     TRAITEMENT DU MODELE
  70. C
  71.       IMODEL=IPMODE
  72.       lsupma=.true.
  73. *
  74. *     TRAITEMENT DES CHAMPS DE MATERIAU
  75. *
  76.          IF (FORMOD(1).EQ.'MECANIQUE') THEN
  77.           IF (CMATE.EQ.'ISOTROPE') THEN
  78.             NBROBL=2
  79.             NBRFAC=0
  80.             SEGINI NOMID
  81.             MOMATR=NOMID
  82.             IF (MFR.EQ.35) THEN
  83.               LESOBL(1)='KS  '
  84.               LESOBL(2)='KN  '
  85. *
  86.             ELSE IF(MFR.EQ.53)THEN
  87.               NBROBL=1
  88.               SEGADJ,NOMID
  89.               LESOBL(1)='KS  '
  90. *
  91.             ELSE
  92.               LESOBL(1)='YOUN'
  93.               LESOBL(2)='NU  '
  94.             ENDIF
  95.             NMATR=NBROBL
  96.             NMATF=NBRFAC
  97.           ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  98.                IF (MFR.EQ.3) THEN
  99. *                 COQUES MINCES
  100.                  NBROBL=6
  101.                  NBRFAC=0
  102.                  SEGINI NOMID
  103.                  MOMATR=NOMID
  104.                  LESOBL(1)='YG1 '
  105.                  LESOBL(2)='YG2 '
  106.                  LESOBL(3)='NU12'
  107.                  LESOBL(4)='G12 '
  108.                  LESOBL(5)='V1X '
  109.                  LESOBL(6)='V1Y '
  110.                ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN
  111. *                 COQUES    AVEC CISAILLEMENT TRANSVERSE
  112.                  NBROBL=8
  113.                  NBRFAC=0
  114.                  SEGINI NOMID
  115.                  MOMATR=NOMID
  116.                  LESOBL(1)='YG1 '
  117.                  LESOBL(2)='YG2 '
  118.                  LESOBL(3)='NU12'
  119.                  LESOBL(4)='G12 '
  120.                  LESOBL(5)='G23 '
  121.                  LESOBL(6)='G13 '
  122.                  LESOBL(7)='V1X '
  123.                  LESOBL(8)='V1Y '
  124.                ELSE IF (MFR.EQ.1) THEN
  125. *                 ELEMENTS MASSIFS
  126.                   IF(IDIM.EQ.3)THEN
  127. *                    ELEMENTS 3D
  128.                     NBROBL=15
  129.                     NBRFAC=0
  130.                     SEGINI NOMID
  131.                     MOMATR=NOMID
  132.                     LESOBL(1)='YG1 '
  133.                     LESOBL(2)='YG2 '
  134.                     LESOBL(3)='YG3 '
  135.                     LESOBL(4)='NU12'
  136.                     LESOBL(5)='NU23'
  137.                     LESOBL(6)='NU13'
  138.                     LESOBL(7)='G12 '
  139.                     LESOBL(8)='G23 '
  140.                     LESOBL(9)='G13 '
  141.                     LESOBL(10)='V1X '
  142.                     LESOBL(11)='V1Y '
  143.                     LESOBL(12)='V1Z '
  144.                     LESOBL(13)='V2X '
  145.                     LESOBL(14)='V2Y '
  146.                     LESOBL(15)='V2Z '
  147.                   ELSE IF (IDIM.EQ.2) THEN
  148.                      IF(IFOUR.EQ.-2)THEN
  149. *                       CONTRAINTE PLANE
  150.                        NBROBL=6
  151.                        NBRFAC=0
  152.                        SEGINI NOMID
  153.                        MOMATR=NOMID
  154.                        LESOBL(1)='YG1 '
  155.                        LESOBL(2)='YG2 '
  156.                        LESOBL(3)='NU12'
  157.                        LESOBL(4)='G12 '
  158.                        LESOBL(5)='V1X '
  159.                        LESOBL(6)='V1Y '
  160.          ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  161. *                       DEFORMATION PLANE ,AXISYMETRIE
  162.                        NBROBL=9
  163.                        NBRFAC=0
  164.                        SEGINI NOMID
  165.                        MOMATR=NOMID
  166.                        LESOBL(1)='YG1 '
  167.                        LESOBL(2)='YG2 '
  168.                        LESOBL(3)='YG3 '
  169.                        LESOBL(4)='NU12'
  170.                        LESOBL(5)='NU23'
  171.                        LESOBL(6)='NU13'
  172.                        LESOBL(7)='G12 '
  173.                        LESOBL(8)='V1X '
  174.                        LESOBL(9)='V1Y '
  175.                      ELSE IF (IFOUR.EQ.1) THEN
  176. *                       AXISYMETRIE DE FOURIER
  177.                        NBROBL=11
  178.                        NBRFAC=0
  179.                        SEGINI NOMID
  180.                        MOMATR=NOMID
  181.                        LESOBL(1)='YG1 '
  182.                        LESOBL(2)='YG2 '
  183.                        LESOBL(3)='YG3 '
  184.                        LESOBL(4)='NU12'
  185.                        LESOBL(5)='NU23'
  186.                        LESOBL(6)='NU13'
  187.                        LESOBL(7)='G12 '
  188.                        LESOBL(8)='G23 '
  189.                        LESOBL(9)='G13 '
  190.                        LESOBL(10)='V1X '
  191.                        LESOBL(11)='V1Y '
  192.                      ENDIF
  193.                   ENDIF
  194.                ELSE IF (MFR.EQ.35) THEN
  195. *                 ELEMENTS JOINTS
  196.                   IF (IFOUR.EQ.2) THEN
  197.                      NBROBL=5
  198.                      NBRFAC=0
  199.                      SEGINI NOMID
  200.                      MOMATR=NOMID
  201.                      LESOBL(1)='KS1 '
  202.                      LESOBL(2)='KS2 '
  203.                      LESOBL(3)='KN  '
  204.                      LESOBL(4)='V1X '
  205.                      LESOBL(5)='V1Y '
  206.                   ENDIF
  207.                ENDIF
  208.                NMATR=NBROBL
  209.                NMATF=NBRFAC
  210.           ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  211.                IF(MFR.EQ.1)THEN
  212. *                 ELEMENTS MASSIFS
  213.                   IF(IDIM.EQ.3)THEN
  214. *                    ELEMENTS 3D
  215.                    IF (IFOUR.EQ.2) THEN
  216.                     NBROBL=27
  217.                     NBRFAC=0
  218.                     SEGINI NOMID
  219.                     MOMATR=NOMID
  220.                     LESOBL(1)='D11 '
  221.                     LESOBL(2)='D21 '
  222.                     LESOBL(3)='D22 '
  223.                     LESOBL(4)='D31 '
  224.                     LESOBL(5)='D32 '
  225.                     LESOBL(6)='D33 '
  226.                     LESOBL(7)='D41 '
  227.                     LESOBL(8)='D42 '
  228.                     LESOBL(9)='D43 '
  229.                     LESOBL(10)='D44 '
  230.                     LESOBL(11)='D51 '
  231.                     LESOBL(12)='D52 '
  232.                     LESOBL(13)='D53 '
  233.                     LESOBL(14)='D54 '
  234.                     LESOBL(15)='D55 '
  235.                     LESOBL(16)='D61 '
  236.                     LESOBL(17)='D62 '
  237.                     LESOBL(18)='D63 '
  238.                     LESOBL(19)='D64 '
  239.                     LESOBL(20)='D65 '
  240.                     LESOBL(21)='D66 '
  241.                     LESOBL(22)='V1X '
  242.                     LESOBL(23)='V1Y '
  243.                     LESOBL(24)='V1Z '
  244.                     LESOBL(25)='V2X '
  245.                     LESOBL(26)='V2Y '
  246.                     LESOBL(27)='V2Z '
  247.                    ENDIF
  248.                   ELSE IF (IDIM.EQ.2) THEN
  249.                      IF (IFOUR.EQ.-2) THEN
  250. *                       CONTRAINTE PLANE
  251.                        NBROBL=8
  252.                        NBRFAC=0
  253.                        SEGINI NOMID
  254.                        MOMATR=NOMID
  255.                        LESOBL(1)='D11 '
  256.                        LESOBL(2)='D21 '
  257.                        LESOBL(3)='D22 '
  258.                        LESOBL(4)='D41 '
  259.                        LESOBL(5)='D42 '
  260.                        LESOBL(6)='D44 '
  261.                        LESOBL(7)='V1X '
  262.                        LESOBL(8)='V1Y '
  263.          ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  264. *                    DEFORMATION PLANE ,AXISYMETRIE
  265.                        NBROBL=12
  266.                        NBRFAC=0
  267.                        SEGINI NOMID
  268.                        MOMATR=NOMID
  269.                        LESOBL(1)='D11 '
  270.                        LESOBL(2)='D21 '
  271.                        LESOBL(3)='D22 '
  272.                        LESOBL(4)='D31 '
  273.                        LESOBL(5)='D32 '
  274.                        LESOBL(6)='D33 '
  275.                        LESOBL(7)='D41 '
  276.                        LESOBL(8)='D42 '
  277.                        LESOBL(9)='D43 '
  278.                        LESOBL(10)='D44 '
  279.                        LESOBL(11)='V1X '
  280.                        LESOBL(12)='V1Y '
  281.                      ELSE IF (IFOUR.EQ.1) THEN
  282. *                       AXISYMETRIE DE FOURIER
  283.                        NBROBL=15
  284.                        NBRFAC=0
  285.                        SEGINI NOMID
  286.                        MOMATR=NOMID
  287.                        LESOBL(1)='D11 '
  288.                        LESOBL(2)='D21 '
  289.                        LESOBL(3)='D22 '
  290.                        LESOBL(4)='D31 '
  291.                        LESOBL(5)='D32 '
  292.                        LESOBL(6)='D33 '
  293.                        LESOBL(7)='D41 '
  294.                        LESOBL(8)='D42 '
  295.                        LESOBL(9)='D43 '
  296.                        LESOBL(10)='D44 '
  297.                        LESOBL(11)='D55 '
  298.                        LESOBL(12)='D65 '
  299.                        LESOBL(13)='D66 '
  300.                        LESOBL(14)='V1X '
  301.                        LESOBL(15)='V1Y '
  302.                      ENDIF
  303.                   ENDIF
  304.                ENDIF
  305.                NMATR=NBROBL
  306.                NMATF=NBRFAC
  307.           ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  308.              IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN
  309.               NBROBL=7
  310.               NBRFAC=0
  311.               SEGINI NOMID
  312.               MOMATR=NOMID
  313.               LESOBL(1)='YOUN'
  314.               LESOBL(2)='V1X '
  315.               LESOBL(3)='V1Y '
  316.               LESOBL(4)='V1Z '
  317.               LESOBL(5)='V2X '
  318.               LESOBL(6)='V2Y '
  319.               LESOBL(7)='V2Z '
  320.              ELSE
  321.               NBROBL=3
  322.               NBRFAC=0
  323.               SEGINI NOMID
  324.               MOMATR=NOMID
  325.               LESOBL(1)='YOUN'
  326.               LESOBL(2)='V1X '
  327.               LESOBL(3)='V1Y '
  328.              ENDIF
  329.              NMATR=NBROBL
  330.              NMATF=NBRFAC
  331.          ELSE
  332.             if(lnomid(6).ne.0) then
  333.              nomid=lnomid(6)
  334.              segact nomid
  335.              momatr=nomid
  336.              nmatr=lesobl(/2)
  337.              nmatf=lesfac(/2)
  338.              lsupma=.false.
  339.             else
  340.              lsupma=.true.
  341.              CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  342.             endif
  343.          ENDIF
  344.       ELSE
  345.             if(lnomid(6).ne.0) then
  346.              nomid=lnomid(6)
  347.              segact nomid
  348.              momatr=nomid
  349.              nmatr=lesobl(/2)
  350.              nmatf=lesfac(/2)
  351.              lsupma=.false.
  352.             else
  353.              lsupma=.true.
  354.              CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  355.             endif
  356.       ENDIF
  357. *
  358.       IF (MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN
  359.          NBTYPE=3
  360.          SEGINI NOTYPE
  361.          TYPE(1)='POINTEURMMODEL'
  362.          TYPE(2)='POINTEURMCHAML'
  363.          TYPE(3)='POINTEURLISTREEL'
  364.       ELSE
  365.          NBTYPE=1
  366.          SEGINI NOTYPE
  367.          TYPE(1)='REAL*8'
  368.       ENDIF
  369.       MOTYPE=NOTYPE
  370.       CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IMAT)
  371.       SEGSUP NOTYPE
  372.       IF (IERR.NE.0) GOTO 9990
  373.       NUMAT=NMATR+NMATF
  374. *
  375.       IF (MOMATR.NE.0.AND.ISUP5.EQ.1) THEN
  376.         CALL VALCHE (IMAT,NUMAT,IPMINT,IPPORE,MOMATR,MELE)
  377.       ENDIF
  378. *
  379. C____________________________________________________________________
  380. C
  381. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  382. C____________________________________________________________________
  383. C
  384.          NBROBL=0
  385.          NBRFAC=0
  386.          NOMID=0
  387. *
  388. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  389. *
  390.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  391.            NBROBL=1
  392.            NBRFAC=1
  393.            SEGINI NOMID
  394.            LESOBL(1)='EPAI'
  395.            LESFAC(1)='EXCE'
  396. *
  397. * SECTION POUR LES BARRES
  398. *
  399.          ELSE IF (MFR.EQ.27) THEN
  400.            NBROBL=1
  401.            SEGINI NOMID
  402.            LESOBL(1)='SECT'
  403. c+mdj
  404. *
  405. * section, excentrements et orientation pour les barres excentrees
  406. *
  407.          ELSE IF (MFR.EQ.49) THEN
  408.            NBROBL=6
  409.            SEGINI NOMID
  410.            LESOBL(1)='SECT'
  411.            LESOBL(2)='EXCZ'
  412.            LESOBL(3)='EXCY'
  413.            LESOBL(4)='VX  '
  414.            LESOBL(5)='VY  '
  415.            LESOBL(6)='VZ  '
  416. *
  417.            NBTYPE=1
  418.            SEGINI NOTYPE
  419.            MOTYPE=NOTYPE
  420.            TYPE(1)='REAL*8'
  421. c+mdj
  422. *
  423. * CARACTERISTIQUES POUR LES POUTRES
  424. *
  425.          ELSE IF (MFR.EQ.7 ) THEN
  426.            IF (CMATE.NE.'SECTION') THEN
  427.               IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  428.                NBRFAC=1
  429.                NBROBL=2
  430.                SEGINI NOMID
  431.                LESOBL(1)= 'SECT'
  432.                LESOBL(2)= 'INRZ'
  433.                LESFAC(1)= 'SECY'
  434.              ELSE
  435.                NBROBL=4
  436.                NBRFAC=2
  437.                SEGINI NOMID
  438.                LESOBL(1)='TORS'
  439.                LESOBL(2)='INRY'
  440.                LESOBL(3)='INRZ'
  441.                LESOBL(4)='SECT'
  442.                LESFAC(1)='SECY'
  443.                LESFAC(2)='SECZ'
  444.              ENDIF
  445.            ELSE
  446.              NBROBL=0
  447.              NBRFAC=3
  448.              SEGINI NOMID
  449.              LESFAC(1)='VX'
  450.              LESFAC(2)='VY'
  451.              LESFAC(3)='VZ'
  452.            ENDIF
  453. *
  454. * CARACTERISTIQUES POUR LES TUYAUX
  455. *
  456.          ELSE IF (MFR.EQ.13) THEN
  457.            NBROBL=2
  458.            NBRFAC=8
  459.            SEGINI NOMID
  460.            LESOBL(1)='EPAI'
  461.            LESOBL(2)='RAYO'
  462.            LESFAC(1)='RACO'
  463.            LESFAC(2)='PRES'
  464.            LESFAC(3)='CISA'
  465.            LESFAC(4)='CFFX'
  466.            LESFAC(5)='CFMX'
  467.            LESFAC(6)='CFMY'
  468.            LESFAC(7)='CFMZ'
  469.            LESFAC(8)='CFPR'
  470. *
  471. * CARACTERISTIQUES POUR LES LINESPRING
  472. *
  473.          ELSE IF (MFR.EQ.15) THEN
  474.            NBROBL=5
  475.            SEGINI NOMID
  476.            LESOBL(1)='EPAI'
  477.            LESOBL(2)='FISS'
  478.            LESOBL(3)='VX  '
  479.            LESOBL(4)='VY  '
  480.            LESOBL(5)='VZ  '
  481. *
  482. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  483. *
  484.          ELSE IF (MFR.EQ.17) THEN
  485.            NBROBL=9
  486.            SEGINI NOMID
  487.            LESOBL(1)='RAYO'
  488.            LESOBL(2)='EPAI'
  489.            LESOBL(3)='VX  '
  490.            LESOBL(4)='VY  '
  491.            LESOBL(5)='VZ  '
  492.            LESOBL(6)='VXF '
  493.            LESOBL(7)='VYF '
  494.            LESOBL(8)='VZF '
  495.            LESOBL(9)='ANGL'
  496. *
  497. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  498. *
  499.          ELSE IF (MFR.EQ.37) THEN
  500.            IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  501.              NBROBL=5
  502.              SEGINI NOMID
  503.              LESOBL(1)='SCEL'
  504.              LESOBL(2)='SFLU'
  505.              LESOBL(3)='EPS '
  506.              LESOBL(4)='SECT'
  507.              LESOBL(5)='INRZ'
  508.            ELSE
  509.              NBROBL=3
  510.              NBRFAC=2
  511.              SEGINI NOMID
  512.              LESOBL(1)='SCEL'
  513.              LESOBL(2)='SFLU'
  514.              LESOBL(3)='EPS '
  515.              LESFAC(1)='NOF1'
  516.              LESFAC(2)='NOF2'
  517.            ENDIF
  518.          ENDIF
  519. *
  520.          MOCARA=NOMID
  521.          NCARA=NBROBL
  522.          NCARF=NBRFAC
  523.          NUCAR=NCARA+NCARF
  524.          IF (IPCHE1.NE.0.AND.MOCARA.NE.0)  THEN
  525.           NBTYPE=1
  526.           SEGINI NOTYPE
  527.           TYPE(1)='REAL*8'
  528.           IF(CMATE.EQ.'SECTION')TYPE(1)='POINTEURPOINT   '
  529.           MOTYPE=NOTYPE
  530.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,ICAR)
  531.           SEGSUP NOTYPE
  532.           IF (IERR.NE.0) GOTO 9990
  533.           NOMID=MOCARA
  534.           SEGDES NOMID
  535.          ENDIF
  536. *
  537.          IF (MOCARA.NE.0.AND.ISUP5.EQ.1) THEN
  538.             CALL VALCHE (ICAR,NUCAR,IPMINT,IPPORE,MOCARA,MELE)
  539.          ENDIF
  540. *
  541.         RETURN
  542. *
  543.  9990 CONTINUE
  544. *
  545. *     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  546. *
  547.       IRET  =0
  548. *
  549.       IF (ISUP5.EQ.1) THEN
  550.         CALL DTMVAL(IMAT,3)
  551.         CALL DTMVAL(ICAR,3)
  552.       ELSE
  553.         CALL DTMVAL(IMAT,1)
  554.         CALL DTMVAL(ICAR,1)
  555.       ENDIF
  556. *
  557.       NOMID=MOCARA
  558.       IF (MOCARA.NE.0) SEGSUP NOMID
  559.       NOMID=MOMATR
  560.       IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  561. *
  562.       SEGDES IMODEL
  563. *
  564.       IF (IPCHE1.NE.0) THEN
  565.         MCHEL1=IPCHE1
  566.         SEGDES MCHEL1
  567.       ENDIF
  568.  
  569.       RETURN
  570.       END
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  

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