Télécharger la plaquette Cast3M


fr en

Télécharger defmat.eso

Retour à la liste

Numérotation des lignes : 

defmat

  1. C DEFMAT    SOURCE    JB251061  22/12/21    21:15:03     11521          
  2. C DEFMAT    SOURCE    BP208322  17/03/01    21:16:57     9325           
  3.       SUBROUTINE DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  4.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  5.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,
  6.      .        XMOB,BID,BID2,KERR0)
  7. *
  8. *********************************************************
  9. *  ENTREES
  10. *********************************************************
  11. *
  12. * NMATT    : nombre de composantes matériau
  13. * NSTRS    : nombre de composantes des contraintes
  14. * MFR      : formulation de l'élément
  15. * INPLAS   : numéro du matériau inélastique
  16. * IVAMAT   : pointeur sur un segment mptval de materiau
  17. * IB       : numéro de l'élément
  18. * IGAU     : numéro du point de Gauss
  19. * CMATE    : nom du matériau
  20. * MATE     : numéro du matériau
  21. * LUNI1    : booléen pour le matériau ACIER_UNI
  22. * LUNI2    : booléen pour le matériau ACIER_UNI
  23. * TXR      : cosinus directeur des axes locaux pour l'ACIER_UNI
  24. *            (WTRAV)
  25. *
  26. *********************************************************
  27. *  SORTIES
  28. *********************************************************
  29. *
  30. * SIG0     : contraintes effectives (WRK1)
  31. * EPST0    : deformations totales au debut du pas (WRK5)
  32. * XMAT     : composantes matériaux (WRK0)
  33. * CMASS    : élément de réduction de la masse
  34. * CRIGI    : élément de réduction de la rigidité
  35. * TYMAT    : type des composantes materiau (WR00)
  36. * COB      : porosité (éventuelle)
  37. * BID      :
  38. * BID2     :
  39. * KERR0    : indicateur d'erreur
  40. *
  41. *********************************************************
  42. *
  43.       IMPLICIT INTEGER(I-N)
  44.       IMPLICIT REAL*8(A-H,O-Z)
  45. *
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC SMCHAML
  50. -INC SMLREEL
  51. *
  52.       SEGMENT MPTVAL
  53.         INTEGER IPOS(NS)    ,NSOF(NS)
  54.         INTEGER      IVAL(NCOSOU)
  55.         CHARACTER*16 TYVAL(NCOSOU)
  56.       ENDSEGMENT
  57. *
  58.       SEGMENT WRK0
  59.        REAL*8 XMAT(NCXMAT)
  60.       ENDSEGMENT
  61. *
  62.       SEGMENT WR00
  63.        CHARACTER*16 TYMAT(NCXMAT)
  64.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  65.       ENDSEGMENT
  66. *
  67.       SEGMENT WRK1
  68.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  69.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  70.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  71.       ENDSEGMENT
  72. *
  73.       SEGMENT WRK5
  74.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  75.       ENDSEGMENT
  76. *
  77.       SEGMENT WTRAV
  78.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  79.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  80.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  81.         REAL*8 XLOC(3,3),XGLOB(3,3)
  82.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  83.       ENDSEGMENT
  84. *
  85.       DIMENSION CRIGI(12),CMASS(12)
  86.       DIMENSION BID(*),BID2(*)
  87.       LOGICAL LUNI1,LUNI2
  88.       CHARACTER*8  CMATE
  89. *
  90. *     on recupere les constantes du materiau
  91. *
  92. *
  93. * >>>>>>>>>>  cas des materiaux orthotropes plastiques decouples
  94. *
  95. c mistral :
  96.       IF ((INPLAS.EQ.67).OR.(INPLAS.EQ.68).OR.(INPLAS.EQ.94)) THEN
  97. c mistral.
  98.          MPTVAL=IVAMAT
  99.          DO IC=1,NMATT
  100.             MELVAL=IVAL(IC)
  101.             IAUX=MELVAL
  102.             IF(IAUX.NE.0) THEN
  103.                 IF(TYVAL(IC)(1:8).NE.'POINTEUR') THEN
  104.                        IBMN=MIN(IB,VELCHE(/2))
  105.                        IGMN=MIN(IGAU,VELCHE(/1))
  106.                        XMAT(IC)=VELCHE(IGMN,IBMN)
  107.                 ELSE
  108.                        IBMN=MIN(IB,IELCHE(/2))
  109.                        IGMN=MIN(IGAU,IELCHE(/1))
  110.                        XMAT(IC)=IELCHE(IGMN,IBMN)
  111.                 ENDIF
  112.             ELSE
  113.                 XMAT(IC)=0.D0
  114.                 IF(TYVAL(IC)(1:8).EQ.'POINTEUR') XMAT(IC)=0
  115.             ENDIF
  116.          END DO
  117.          GOTO 1000
  118.       ENDIF
  119. *
  120. * >>>>>>>>>>  cas du SIC_SIC
  121. *
  122.       IF (INPLAS.EQ.88) THEN
  123.          MPTVAL=IVAMAT
  124.          DO IC=1,NMATT
  125.             MELVAL=IVAL(IC)
  126.             IAUX=MELVAL
  127.             IF(IAUX.NE.0) THEN
  128.                 IF(TYVAL(IC)(1:8).NE.'POINTEUR') THEN
  129.                        IBMN=MIN(IB,VELCHE(/2))
  130.                        IGMN=MIN(IGAU,VELCHE(/1))
  131.                        XMAT(IC)=VELCHE(IGMN,IBMN)
  132.                 ELSE
  133.                        IBMN=MIN(IB,IELCHE(/2))
  134.                        IGMN=MIN(IGAU,IELCHE(/1))
  135.                        XMAT(IC)=IELCHE(IGMN,IBMN)
  136.                 ENDIF
  137.             ELSE
  138.                 XMAT(IC)=0.D0
  139.                 IF(TYVAL(IC)(1:8).EQ.'POINTEUR') XMAT(IC)=0
  140.             ENDIF
  141.          END DO
  142.          GOTO 1000
  143.       ENDIF
  144. *
  145. *     cas des poutres en formulation section
  146. *
  147.       IF ((MFR.EQ.7.OR.MFR.EQ.13).AND.
  148.      1        CMATE.EQ.'SECTION') THEN
  149.                 MPTVAL=IVAMAT
  150.                 DO IC=1,NMATT
  151.                   MELVAL=IVAL(IC)
  152.                   IAUX=MELVAL
  153.                   IF(IAUX.NE.0)THEN
  154.                     IBMN=MIN(IB,IELCHE(/2))
  155.                     IGMN=MIN(IGAU,IELCHE(/1))
  156.                     XMAT(IC)=DBLE(IELCHE(IGMN,IBMN))
  157.                     IF(IC.EQ.1) IPM=IELCHE(IGMN,IBMN)
  158.                     IF(IC.EQ.2) IPC=IELCHE(IGMN,IBMN)
  159.                   ELSE
  160.                     XMAT(IC)=DBLE(0)
  161.                   ENDIF
  162.                 END DO
  163.                 IF (INPLAS.EQ.0) THEN
  164.                   MLREEL = NINT(XMAT(3))
  165.                   IF(MLREEL.EQ.0)THEN
  166.                     CALL FRIGIE(IPM,IPC,CRIGI,CMASS)
  167.                   ELSE
  168.                     SEGACT, MLREEL
  169.                     CALL BIFLX1(PROG(1),NSTRS,CRIGI)
  170.                     SEGDES, MLREEL
  171.                   ENDIF
  172.                 ENDIF
  173. *
  174. * >>>>>>>>>>  cas des materiaux elastiques isotropes
  175. *                                       ou unidirectionnels
  176.       ELSE IF(MATE.EQ.1.OR.MATE.EQ.4) THEN
  177.             MPTVAL=IVAMAT
  178.             IF(INPLAS.EQ. 9.OR.INPLAS.EQ.28.OR.INPLAS.EQ.36.
  179.      &      OR.INPLAS.EQ.42.OR.INPLAS.EQ.65.
  180.      &      OR.INPLAS.EQ.66.OR.INPLAS.EQ.74) THEN
  181. *
  182. *             pour les modeles beton et ubiquitous
  183. *             et ceux dont on ne remodifie pas l'ordre
  184. *
  185.                  DO 1105 IC=1,NMATT
  186.                     MELVAL=IVAL(IC)
  187.                     IAUX=MELVAL
  188.                     IF(IAUX.NE.0)THEN
  189.                        IF(VELCHE(/1)+VELCHE(/2).NE.0) THEN
  190.                          IBMN=MIN(IB,VELCHE(/2))
  191.                          IGMN=MIN(IGAU,VELCHE(/1))
  192.                          XMAT(IC)=VELCHE(IGMN,IBMN)
  193.                        ELSE IF(IELCHE(/1)+IELCHE(/2).NE.0) THEN
  194.                          IBMN=MIN(IB  ,IELCHE(/2))
  195.                          IGMN=MIN(IGAU,IELCHE(/1))
  196.                          XMAT(IC)=DBLE(IELCHE(IGMN,IBMN))
  197.                        ENDIF
  198.                     ELSE
  199.                        XMAT(IC)=0.D0
  200.                     ENDIF
  201. *              print *,'defmat XMAT(',IC,')=',XMAT(IC)
  202. 1105              continue
  203. *
  204.               ELSE
  205. *
  206. *           pour les autres modeles :
  207. *           on a les noms : e,nu,puis le reste des obligatoires
  208. *           puis les facultatives qui se terminent par rho et alph
  209. *           d'apres un rangement dans idmatr
  210. *           dans le remplissage de xmat, on veut e,nu,rho,alph
  211. *           puis la suite. d'ou ce qui suit ....
  212. *  am 9/11/93  a reprendre  !!
  213. *  am 28/7/95  le commentaire ci dessus est FAUX si l'on a des
  214. *              proprietes facultatives en plus de rho et alph
  215. *              car dans ce cas les facultatives COMMENCENT par
  216. *              rho et alph.   a reprendre  !!!!!!!!
  217. *
  218.                  DO 1106  IC=1,NMATT
  219.                    IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31
  220.      +                  .OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN
  221.                     IF(IC.LE.2.OR.IC.EQ.NMATT) JC=IC
  222.                     IF(IC.GT.2.AND.IC.LT.NMATT-2) JC=IC+2
  223.                     IF(IC.EQ.NMATT-2) JC=3
  224.                     IF(IC.EQ.NMATT-1)   JC=4
  225. C
  226.                    ELSEIF(MFR.EQ.53)THEN
  227.                     III=1
  228.                     IF(IC.LE.III.OR.IC.EQ.NMATT) JC=IC
  229.                     IF(IC.GT.III.AND.IC.LT.NMATT-2) JC=IC+2
  230.                     IF(IC.EQ.NMATT-2) JC=III+1
  231.                     IF(IC.EQ.NMATT-1) JC=III+2
  232.  
  233.                    ELSEIF(INPLAS.EQ.64)THEN
  234. C                    GURSON2
  235.                     IF(IC.LE.2) JC=IC
  236.                     IF(IC.GT.2.AND.IC.LT.15) JC=IC+2
  237.                     IF(IC.EQ.15) JC=3
  238.                     IF(IC.EQ.16) JC=4
  239.                    ELSE
  240.                     IF(IC.LE.2) JC=IC
  241.                     IF(IC.GT.2.AND.IC.LT.NMATT-1) JC=IC+2
  242.                     IF(IC.EQ.NMATT-1) JC=3
  243.                     IF(IC.EQ.NMATT)   JC=4
  244.                    ENDIF
  245.                    MELVAL=IVAL(IC)
  246.                    IAUX=MELVAL
  247.                    IF(IAUX.NE.0)THEN
  248.                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  249.                        IBMN=MIN(IB,VELCHE(/2))
  250.                        IGMN=MIN(IGAU,VELCHE(/1))
  251.                        XMAT(JC)=VELCHE(IGMN,IBMN)
  252.                       TYMAT(JC)=TYVAL(IC)
  253.                     ELSE
  254.                        IBMN=MIN(IB,IELCHE(/2))
  255.                        IGMN=MIN(IGAU,IELCHE(/1))
  256.                        XMAT(JC)=IELCHE(IGMN,IBMN)
  257.                       TYMAT(JC)=TYVAL(IC)
  258.                     ENDIF
  259.                  ELSE
  260.                     XMAT(JC)=0.D0
  261.                     TYMAT(JC)='REAL*8  '
  262.                  ENDIF
  263. *                 PRINT *,'XMAT(',JC,')=',XMAT(JC)
  264. 1106             continue
  265. *
  266. *        rearrangement pour  certaines lois cas elastique isotrope
  267. *
  268.                   IF(INPLAS.EQ.64) THEN
  269. C                                           gurson2
  270.                        XSRMA=XMAT(3)
  271.                        XMAT(3)=XMAT(17)
  272.                        XMAT(17)=XMAT(4)
  273.                        XMAT(4)=XSRMA
  274.                   ENDIF
  275. C                 IF (INPLAS.EQ.7) THEN
  276. *                                            chaboche 1
  277. C                    IF(XMAT(10).NE.0.OR.XMAT(11).NE.0)THEN
  278. C                       INPLAS=8
  279. C                    ENDIF
  280.                  IF (INPLAS.EQ.2) THEN
  281.                     IF (XMAT(6).NE.0) THEN
  282.                        INPLAS=27
  283.                        XMAT(5)=XMAT(6)
  284.                     ENDIF
  285.                  ENDIF
  286. C                 IF (INPLAS.EQ.12) THEN
  287. *                                            chaboche 2
  288. C                    IF(XMAT(12).NE.0.OR.XMAT(13).NE.0)THEN
  289. C                       INPLAS=13
  290. C                    ENDIF
  291.                  IF (INPLAS.EQ.14) THEN
  292.                     IF(XMAT(8).NE.0.OR.XMAT(9).NE.0)THEN
  293.                        INPLAS=18
  294.                        XMAT(5)=XMAT(8)
  295.                        XMAT(6)=XMAT(9)
  296.                     ENDIF
  297.                  ENDIF
  298.               ENDIF
  299. *
  300. *        rearrangement pour  certaines formulations
  301. *
  302. *             milieu poreux  cas elastique isotrope
  303. *
  304.               IF (MFR.EQ.33) THEN
  305.                 IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN
  306.                   KERR0=99
  307.                   GO TO 1000
  308.                 ENDIF
  309.                 COB=XMAT(5)
  310.                 XMOB=XMAT(6)
  311.                 DO 1992 IC=1,NMATT-12
  312.                 XMAT(4+IC)=XMAT(6+IC)
  313. 1992            continue
  314. *
  315. *             calcul des contraintes effectives
  316. *
  317.                 DO 1993 IC=1,3
  318.                 IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993
  319.                 SIG0(IC) =SIG0(IC)  + COB* EPST0(NSTRS)
  320. 1993            continue
  321.               ENDIF
  322. *
  323. *       rearrangement pour  les materiaux unidirectionnels
  324. *                         en plasticite
  325. *
  326. *      ce qui suit est limité au coq2 et au dst
  327. *
  328. *      on met v1x et v1y à la place de rho et alph
  329. *      on met nu à 0. et on se decale ( on ignore les axes )
  330. *
  331. *      dans le cas des coq2, il faut aller chercher les contraintes
  332. *      dans la direction ad-hoc. inutile pour le dst.
  333. *      on se limite au cas axisymetrique ?
  334. *
  335.               IF (MATE.EQ.4.AND.INPLAS.NE.0.AND.INPLAS.NE.74) THEN
  336. * ppu            if(mele.ne.44.and.mele.ne.93) go to 1000
  337.                  XMAT(3)=XMAT(2)
  338.                  XMAT(2)=0.D0
  339.                  DO 1995 IC=4,NMATT-1
  340.                    XMAT(IC) = XMAT(IC+1)
  341.  1995            CONTINUE
  342. *
  343. *   coq2  : on change les contraintes de repere
  344. *       les variables internes sont dans le repere unidirectionnel
  345. *
  346.                  IF (MELE.EQ.44) THEN
  347.                     DO 1996 I=1,NSTRS
  348.                       BID(I)=SIG0(I)
  349.                       BID2(I)=DSIGT(I)
  350.  1996               CONTINUE
  351. *
  352.                  ELSEIF(LUNI1)THEN
  353.                     V1X=TXR(1,1)*XMAT(3)+TXR(1,2)*XMAT(4)
  354.                     V1Y=TXR(2,1)*XMAT(3)+TXR(2,2)*XMAT(4)
  355.                     XMAT(3)=V1X
  356.                     XMAT(4)=V1Y
  357.                  ELSEIF(LUNI2)THEN
  358.                  ELSE
  359.                    GOTO 1000
  360. *
  361.                  ENDIF
  362.               ENDIF
  363. *
  364.       ENDIF
  365. *
  366. * >>>>>>>>>>   fin du traitement du materiau
  367. *
  368.  1000 RETURN
  369.       END
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  

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