Télécharger la plaquette Cast3M


fr en

Télécharger ecou40.eso

Retour à la liste

Numérotation des lignes : 

ecou40

  1. C ECOU40    SOURCE    OF166741  25/02/21    21:16:04     12166          
  2.       SUBROUTINE ECOU40(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  3.      1     NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  4.      1     IVADS,IVAMAT,IVACAR,
  5.      2     IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVARI,NMATT,NCARR,
  6.      3     CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  7.      4     N2EL,N2PTEL,NBNO,NBPGAU,LW,IVASTF,IVARIF,IVADEP,KERRE)
  8. ***********************************************************************
  9. *      ecoulement inelastique   appele par ecoul1
  10. c ppu  modif pour les materiaux unidirectionels en plastique
  11. *      MATERIAUX: -ENDOMMAGEABLES
  12. ***********************************************************************
  13. * entrees :
  14. *
  15. *  mate   = numero de materiau elastique
  16. *  inplas = numero de materiau inelastique
  17. *  mele   = numero  element fini
  18. *  ipmail = pointeur du maillage
  19. *  nbptel = nombre de points par element
  20. *  imat   = pointeur sur un segment mptval de materiau (utilise par calsig)
  21. *  icar   = pointeur sur un segment mptval de caracteristiques
  22. *           geometriques (utilise par calsig)
  23. *  numat  = nb de composantes du melval de imat
  24. *  nucar  = nb de composantes du melval de icar
  25. *  ivastr =pointeur sur un segment mptval de contraintes
  26. *  ivari  =pointeur sur un segment mptval de variables internes
  27. *  ivadef =pointeur sur un segment mptval de deformations
  28. *  ivads  =pointeur sur un segment mptval de contraintes  (increments)
  29. *  ivamat =pointeur sur un segment mptval de materiau
  30. *  ivacar =pointeur sur un segment mptval de cacarteristiques geometrique
  31. *  iph1  = pointeur sur un mchaml de temperatures au debut du pas
  32. *  iph2  = pointeur sur un mchaml de temperatures a la fin du pas
  33. *  iph3  = pointeur sur un mchaml de temperatures de reference
  34. *  ithher = 0 si pas de chargement thermique
  35. *         = 1 si chargement thermique mais materiau constant
  36. *         = 2 si chargement thermique et mat. dependant de la temperature
  37. *  ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  38. *        endommageables de lemaitre quand ils dependent de la temperature
  39. *  lhook  =taille de la matrice de hooke
  40. *  nstrs  =nombre de composantes de contraintes
  41. *  nvari  =nombre de composantes de variables internes
  42. *  nmatt  =nombre de composnates de proprietes de materiau
  43. *  ncarr  =nombre de composnates de caracteristiques geometriques
  44. *  cmate  =nom du materiau
  45. *  precis =precision dans les iterations internes
  46. *  jecher =0 ou 1 pour action dans ecoule
  47. *  jnoid  =0 ou 1 pour action dans ecoule
  48. *  ipotab =pointeur sur segment table
  49. *  istep  =indicateur d'action pour calcul nonlocal
  50. *        =0 dans le cas d'un calcul local (normal)
  51. *        =1 ou 2 dans le cas d'un calcul nonlocal
  52. *        =1 pour calcul des fonctions seuil uniquement
  53. *        =2 pour calcul des variables dissipatives a partir
  54. *           des fonctions seuil moyennees prealablement par nloc
  55. *
  56. * sorties :
  57. *  ivastf  =pointeur sur un segment mptval de contraintes
  58. *  ivarif  =pointeur sur un segment mptval de variables internes
  59. *  ivadep  =pointeur sur un segment mptval de deformations inelastiques
  60. *  kerre   =indicateur d'erreur
  61. *
  62. *  p dowlatyari  fev. 1992
  63. *
  64. *  c. la borderie fev 92 restructuration et reecriture de certains
  65. *                        passages pour une meilleure lisibilite
  66. *
  67. *                 avril 92 ajout istep pour le non local
  68. *                 dec 92 modif pour poutres timoschenko
  69. *
  70. ************************************************************************
  71.       IMPLICIT INTEGER(I-N)
  72.       IMPLICIT REAL*8(A-H,O-Z)
  73.  
  74. -INC PPARAM
  75. -INC CCOPTIO
  76. -INC CCHAMP
  77. -INC CECOU
  78.  
  79. -INC SMCHAML
  80. -INC SMELEME
  81. -INC SMCOORD
  82. -INC SMMODEL
  83. -INC SMINTE
  84.  
  85. c=======================================================================
  86. c  la variable kerre regit les impressions d erreurs dans plast
  87. c      toutes erreurs de ecoule gerees dans ce sous programme
  88. c   kerre=0 tout ok
  89. c        de 1 a 6  s aligner sur valeurs donnees par ecoinc
  90. c     =   7  un element tuyau a une epaisseur nulle
  91. c     =  21  on ne trouve pas d intersection avec la surface de charge
  92. c     =  22  sig0 a l exterieur de la surface de charge
  93. c
  94. c             anomalies avec la courbe de traction
  95. c     =  30 limite elastique nulle
  96. c     =  31 trop de points
  97. c     =  32 pas assez de points
  98. c     =  33 pente incorrecte
  99. c     =  34 module d'young nul
  100. c     =  35 manque l'origine
  101. c     =  36 pente a l'origine non egale a e
  102. c     =  37 manque la courbe de traction
  103. c     =  38 nu devrait etre nul
  104. c
  105. c     =  48 donnees erronnees pour drucker-prager
  106. c     =  49 matrice singuliere dans iter internes drucker-prager
  107. c     =  51 pb dans drucker prager option non disponible
  108. c     =  52 pb dans drucker prager donnees incompatibles
  109. c     =  53 pb dans drucker prager solution impossible
  110. c     =  54 les valeurs admissibles pour istep sont 0 1 ou 2
  111. c     =  55 modele non implante en non local
  112. c     =  56 probleme dans l'integration du modele mazars
  113. c     =  57  ....
  114. c     =  58  ....
  115. c     =  59  ....
  116. c     =  60 pb donnees du cam-clay
  117. c
  118. c     =  99 cas non encore disponible
  119. c=======================================================================
  120. *
  121.       SEGMENT WRK0
  122.        REAL*8 XMAT(NCXMAT)
  123.       ENDSEGMENT
  124. *
  125.       SEGMENT WR00
  126.        CHARACTER*16 TYMAT(NCXMAT)
  127.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  128.       ENDSEGMENT
  129. *
  130.       SEGMENT WRK1
  131.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  132.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  133.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  134.       ENDSEGMENT
  135. *
  136.       SEGMENT WRK2
  137.         REAL*8 TRAC(LTRAC)
  138.       ENDSEGMENT
  139. *
  140.       SEGMENT WRK22
  141.       REAL*8 XXE(3,NBNN)
  142.       ENDSEGMENT
  143. *
  144.       SEGMENT WRK3
  145.         REAL*8 WORK(LW),WORK2(LW2)
  146.       ENDSEGMENT
  147. *
  148.       SEGMENT WRK4
  149.         REAL*8 XE(3,NBBB)
  150.       ENDSEGMENT
  151. *
  152.       SEGMENT WRK5
  153.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  154.       ENDSEGMENT
  155. *
  156.       SEGMENT WRK6
  157.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  158.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  159.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  160.       ENDSEGMENT
  161. *
  162.       SEGMENT WRK7
  163.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  164.       ENDSEGMENT
  165. *
  166.       SEGMENT WRK8
  167.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  168.       ENDSEGMENT
  169. *
  170.       SEGMENT WRK9
  171.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  172.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  173.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  174.         REAL*8 SIGY(NSIGY)
  175.         INTEGER NKX(NNKX)
  176.       ENDSEGMENT
  177. *
  178.       SEGMENT WR10
  179.         INTEGER IABLO1(NTABO1)
  180.         REAL*8  TABLO2(NTABO2)
  181.       ENDSEGMENT
  182. *
  183.       SEGMENT WR11
  184.         INTEGER IABLO3(NTABO3)
  185.         REAL*8  TABLO4(NTABO4)
  186.       ENDSEGMENT
  187. *
  188.       SEGMENT WTRAV
  189.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  190.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  191.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  192.         REAL*8 XLOC(3,3),XGLOB(3,3)
  193.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  194.       ENDSEGMENT
  195. *
  196.       SEGMENT WPOUT
  197.          REAL*8  X(2),Y(2),Z(2)
  198.       ENDSEGMENT
  199.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  200.       LOGICAL LUNI1,LUNI2
  201.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  202. *
  203.       CHARACTER*72 CHARRE
  204.       CHARACTER*8  CMATE
  205. c
  206. *
  207. *   mise à disposition des temperatures tini tfin tref
  208. *   aux points de gauss
  209. *
  210.          TETA1=-1.E35
  211.          TETA2=-1.E35
  212.          TETREF=-1.E35
  213.          TREFA=-1.E35
  214.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  215.             MCHAM3=IPH1
  216.             MCHAM4=IPH2
  217.             MCHAM5=IPH3
  218.             SEGACT MCHAM3
  219.             SEGACT MCHAM4
  220.             SEGACT MCHAM5
  221.             MELVA3=MCHAM3.IELVAL(1)
  222.             MELVA4=MCHAM4.IELVAL(1)
  223.             MELVA5=MCHAM5.IELVAL(1)
  224.             SEGACT MELVA3
  225.             SEGACT MELVA4
  226.             SEGACT MELVA5
  227.          ENDIF
  228. c
  229. c
  230. c   Initialisations de variables
  231. c---------------------------------
  232. c      - mise à zéro des variables du commun NECOU si besoin
  233. c      - modèles viscoplastiques:
  234. c                  . on récupère le pas de temps
  235. c                  . on récupère le nombre maximal de sous-pas
  236. c                  . on met IND=1
  237. c      - initialisation des dimensions des tableaux des segments
  238. c   Sorties: en plus du commun NECOU, on range les autres données
  239. c   initialisées dans les COMMON IECOU et XECOU
  240. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  241. c   argument de DEFINI
  242. c
  243.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  244.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  245.      .           IPMAIL,IVAMAT,
  246.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  247.      .           LUNI1,LUNI2,LW,KERRE)
  248.       IF (KERRE.EQ.999) RETURN
  249. c
  250. c  Initialisations des segments de travail
  251. c
  252.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  253.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  254.      1     .OR.MFR.EQ.33)) THEN
  255.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  256.         MINTE2=IPTR1
  257.         SEGACT MINTE2
  258.         SEGINI WRK22
  259.       ENDIF
  260. c
  261.       IF (LOGVIS) SEGINI WRK8
  262.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  263.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  264.          SEGINI WRK4
  265.       ENDIF
  266. *      IF(INPLAS.EQ.34)THEN
  267. *        SEGINI WRK8
  268. *      ENDIF
  269. c
  270.       SEGINI WTRAV
  271. *
  272. *
  273. *       boucle sur les elements
  274. *
  275.       DO 1000 IB=1,NBELEM
  276. *
  277. *  Matériaux orthotropes, anisotropes et unidirectionnels
  278. *  en formulation massive:
  279. *     - on cherche  les coordonnees des noeuds de l element ib
  280. *     - calcul des axes locaux
  281. *  Cas particulier de l'ACIER_UNI
  282. *
  283.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  284.      .     MELEME,WRK4,WRK22,WTRAV)
  285. *
  286. *
  287. *       boucle sur les points de gauss
  288. *
  289.          DO 1100 IGAU=1,NBPTEL
  290. *
  291. *  -recuperation de valmat et de valcar
  292. *  -on recupere les contraintes initiales
  293. *  -on recupere les variables internes
  294. *  -on recupere les deformations inelastiques initiales si besoin
  295. *  -on recupere les increments de deformations totales
  296. *  -on cherche la section de l'element ib
  297. *  -prise en compte de l'epaisseur et de l'excentrement
  298. *  dans le cas des coques minces avec ou sans cisaillement
  299. *  transverse
  300. *
  301.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  302.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  303.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  304.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  305. *
  306. *     on recupere les constantes du materiau
  307. *     calcul des contraintes effectives en milieu poreux
  308. *
  309.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  310.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  311.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  312.      .        BID,BID2,KERR0)
  313.       IF (KERR0.EQ.99) THEN
  314.          KERRE=99
  315.          GOTO 1000
  316.       ELSE IF (KERR0.EQ.10) THEN
  317.          GOTO 1000
  318.       ENDIF
  319. *
  320. * >>>>>>>>>>   fin du traitement du materiau
  321. *
  322. *        on recupere les caracteristiques geometriques
  323. *
  324.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  325.      .           WRK1)
  326. *
  327. *
  328. *          quelques impressions si iimpi = 99
  329. *
  330. *      IF(IIMPI.EQ.99) THEN
  331. *         WRITE(IOIMP,66770) IB,IGAU
  332. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  333. *         WRITE(IOIMP,66771) MATE,INPLAS
  334. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  335. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  336. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  337. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  338. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  339. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  340. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  341. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  342. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  343. *         IF(IVACAR.NE.0)THEN
  344. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  345. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  346. *         ENDIF
  347. *      ENDIF
  348. *
  349. *   mise à disposition des temperatures tini tfin tref
  350. *   aux points de gauss
  351. *
  352.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  353.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  354.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  355.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  356.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  357.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  358.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  359.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  360.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  361.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  362.          ENDIF
  363. *
  364. *
  365. *---------------------------------------------------------------------
  366. *
  367. *                  ecoulement selon les modeles
  368. *
  369. *---------------------------------------------------------------------
  370. *
  371.             IF (INPLAS .EQ. 30) THEN
  372. c
  373. c      modele d'endommagement mazars ( beton )
  374. c
  375.                CALL MAZZZ (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  376.      &                                             ICARA,KERRE,MFR1)
  377. c
  378.             ELSE IF (INPLAS .EQ. 31) THEN
  379. c
  380. c      modele d'endommagement unilateral ( beton )
  381. c
  382.                CALL CLBBBB (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  383.      &                                       ICARA,KERRE,MFR1,IFOURB)
  384. c
  385.             ELSE IF (INPLAS .EQ. 37) THEN
  386. c
  387. c      modele rotating crack
  388. c
  389.                CALL ROTATI (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  390.      &                                       ICARA,KERRE)
  391. c
  392.             ELSE IF (INPLAS .EQ. 88) THEN
  393. c      modele SIC_SIC
  394. c
  395.       CALL SICSIC(WRK0,WRK1,WRK22,WRK5,WTRAV,CMATE,N2EL,
  396.      &                 N2PTEL,IB,IGAU,EPAIST,NVARI,NBPGAU,MELE,NPINT,
  397.      &                   SECT,LHOOK,CRIGI,NMATT,ISTEP,KERRE)
  398. c
  399.             ELSE IF (INPLAS .EQ. 89) THEN
  400. C  HINTE
  401. C  MODELE INTERFACE 2D
  402.  
  403.       CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,
  404.      . XCAR,SIGF,VARF,DEFP,PRECIS,MFR1,KERRE)
  405. C
  406.  
  407.             ELSE IF (INPLAS .EQ. 96) THEN
  408. C
  409. C     MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS
  410. C
  411.                CALL MICROP (WRK0,WRK1,NSTRSS,NVARI,NMATT,
  412.      &                                 ICARA,KERRE,MFR1,IFOURB)
  413. *
  414.             ELSE IF (INPLAS .EQ. 97) THEN
  415. C
  416. C      MODELE D'ENDOMMAGEMENT VISCOUNILATERAL ( BETON )
  417. C
  418.                CALL JFDDDD (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  419.      &                                   ICARA,KERRE,MFR1,IFOURB,DT)
  420. *
  421.             ELSE IF (INPLAS .EQ. 98) THEN
  422. C
  423. C     MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS
  424. C
  425.                CALL MICROI (WRK0,WRK1,NSTRSS,NVARI,NMATT,
  426.      &                                 ICARA,KERRE,MFR1,IFOURB)
  427. *
  428. * BCN
  429.             ELSE IF (INPLAS .EQ. 118) THEN
  430. C      Modified Von Mises model
  431.             CALL MVMMM (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  432.      &                                     ICARA,KERRE,MFR1)
  433.             ELSE IF (INPLAS .EQ. 134) THEN
  434. C   Modele de desmorat
  435.           CALL DESMNL(WRK0,WRK1,WRK5,NSTRSS,NVARI,LHOOK,ISTEP,
  436.      &              NMATT,ICARA,KERRE,MFR1)
  437.             ELSE IF (INPLAS .EQ. 135) THEN
  438. *      Modele plastique endommageable ENDO_PLAS
  439.                CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0,
  440.      &                    SIGF,DEPST,NSTRS,KERRE,ISTEP)
  441. C   Fatigue damage model
  442.             ELSE IF (INPLAS .EQ. 141) THEN
  443.                 CALL FATTT (WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  444.      &                                          ICARA,KERRE,MFR1,DT)
  445.  
  446.  
  447.             ELSE
  448.                KERRE = 99
  449.             ENDIF
  450. *
  451. *   Erreurs
  452. *      - problèmes de convergence
  453. *
  454.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  455. *
  456. *      - autres problèmes
  457. *
  458.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  459.      .           KERR1,KERRE)
  460.  1998 IF (KERRE.NE.0) THEN
  461.          IF (LOGVIS) SEGSUP WRK8
  462.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  463.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  464.             SEGSUP WRK4
  465.          ENDIF
  466.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  467.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  468.      1     .OR.MFR.EQ.33)) THEN
  469.            SEGDES MINTE2
  470.            SEGSUP WRK22
  471.          ENDIF
  472.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  473.             SEGDES MELVA3
  474.             SEGDES MELVA4
  475.             SEGDES MELVA5
  476.             SEGDES MCHAM3
  477.             SEGDES MCHAM4
  478.             SEGDES MCHAM5
  479.          ENDIF
  480.          RETURN
  481.       ENDIF
  482. c
  483. c
  484. c     remplissage du segment contenant les contraintes a la fin
  485. *     ( rearrangement pour milieu poreux ),
  486. c     les variables internes finales
  487. c     et les increments de deformations plastiques
  488. c
  489.       CALL DEFSIG(MFR,NDEF,
  490.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  491.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  492.      .     CMATE,MATE,MELE,KERRER)
  493.       IF (KERRER.NE.0) GOTO 1000
  494. c
  495. c
  496. c    fin de la boucle sur les points de gauss
  497. c
  498. 1100     continue
  499. c
  500. c    special poutres et tuyaux  sauf timoschenko
  501. c
  502.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  503. c
  504. c     fin de la boucle sur les elements
  505. c
  506. 1000  continue
  507. *
  508. *  FIN: modèles visqueux, on stocke le pas de temps
  509. *  optimal en indice 'dtopti'
  510. *
  511.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  512.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  513.       IF (LOGVIS) SEGSUP WRK8
  514. *
  515.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  516.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  517.          SEGSUP WRK4
  518.       END IF
  519. *      IF(INPLAS.EQ.34) THEN
  520. *        SEGSUP WRK8
  521. *      END IF
  522.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  523.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  524.      1     .OR.MFR.EQ.33)) THEN
  525.         SEGDES MINTE2
  526.         SEGSUP WRK22
  527.       ENDIF
  528. *
  529.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  530.             SEGDES MELVA3
  531.             SEGDES MELVA4
  532.             SEGDES MELVA5
  533.             SEGDES MCHAM3
  534.             SEGDES MCHAM4
  535.             SEGDES MCHAM5
  536.       ENDIF
  537. *
  538.       RETURN
  539.       END
  540.  
  541.  
  542.  

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