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

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