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

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