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

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