Télécharger la plaquette Cast3M


fr en

Télécharger ecou50.eso

Retour à la liste

Numérotation des lignes : 

ecou50

  1. C ECOU50    SOURCE    CB215821  24/04/12    21:15:43     11897          
  2.       SUBROUTINE ECOU50(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: -PLASTIQUE_ENDOM(MAGEABLE)
  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.  
  75. -INC PPARAM
  76. -INC CCOPTIO
  77. -INC SMCHAML
  78. -INC SMELEME
  79. -INC SMCOORD
  80. -INC SMMODEL
  81. -INC SMINTE
  82. -INC CCHAMP
  83. -INC CECOU
  84. c=======================================================================
  85. c  la variable kerre regit les impressions d erreurs dans plast
  86. c      toutes erreurs de ecoule gerees dans ce sous programme
  87. c   kerre=0 tout ok
  88. c        de 1 a 6  s aligner sur valeurs donnees par ecoinc
  89. c     =   7  un element tuyau a une epaisseur nulle
  90. c     =  21  on ne trouve pas d intersection avec la surface de charge
  91. c     =  22  sig0 a l exterieur de la surface de charge
  92. c
  93. c             anomalies avec la courbe de traction
  94. c     =  30 limite elastique nulle
  95. c     =  31 trop de points
  96. c     =  32 pas assez de points
  97. c     =  33 pente incorrecte
  98. c     =  34 module d'young nul
  99. c     =  35 manque l'origine
  100. c     =  36 pente a l'origine non egale a e
  101. c     =  37 manque la courbe de traction
  102. c     =  38 nu devrait etre nul
  103. c
  104. c     =  48 donnees erronnees pour drucker-prager
  105. c     =  49 matrice singuliere dans iter internes drucker-prager
  106. c     =  51 pb dans drucker prager option non disponible
  107. c     =  52 pb dans drucker prager donnees incompatibles
  108. c     =  53 pb dans drucker prager solution impossible
  109. c     =  54 les valeurs admissibles pour istep sont 0 1 ou 2
  110. c     =  55 modele non implante en non local
  111. c     =  56 probleme dans l'integration du modele mazars
  112. c     =  57  ....
  113. c     =  58  ....
  114. c     =  59  ....
  115. c     =  60 pb donnees du cam-clay
  116. c
  117. c     =  99 cas non encore disponible
  118. c=======================================================================
  119. *
  120.       SEGMENT MPTVAL
  121.         INTEGER IPOS(NS)    ,NSOF(NS)
  122.         INTEGER      IVAL(NCOSOU)
  123.         CHARACTER*16 TYVAL(NCOSOU)
  124.       ENDSEGMENT
  125. *
  126.       SEGMENT WRK0
  127.        REAL*8 XMAT(NCXMAT)
  128.       ENDSEGMENT
  129. *
  130.       SEGMENT WR00
  131.        CHARACTER*16 TYMAT(NCXMAT)
  132.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  133.       ENDSEGMENT
  134. *
  135.       SEGMENT WRK1
  136.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  137.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  138.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  139.       ENDSEGMENT
  140. *
  141.       SEGMENT WRK2
  142.         REAL*8 TRAC(LTRAC)
  143.       ENDSEGMENT
  144. *
  145.       SEGMENT ENDO0
  146.         REAL*8 ENDO(LENDO),RAPP(LENDO)
  147.       ENDSEGMENT
  148. *
  149.       SEGMENT WRK22
  150.       REAL*8 XXE(3,NBNN)
  151.       ENDSEGMENT
  152. *
  153.       SEGMENT WRK3
  154.         REAL*8 WORK(LW),WORK2(LW2)
  155.       ENDSEGMENT
  156. *
  157.       SEGMENT WRK4
  158.         REAL*8 XE(3,NBBB)
  159.       ENDSEGMENT
  160. *
  161.       SEGMENT WRK5
  162.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  163.       ENDSEGMENT
  164. *
  165.       SEGMENT WRK6
  166.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  167.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  168.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  169.       ENDSEGMENT
  170. *
  171.       SEGMENT WRK7
  172.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  173.       ENDSEGMENT
  174. *
  175.       SEGMENT WRK8
  176.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  177.       ENDSEGMENT
  178. *
  179.       SEGMENT WRK9
  180.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  181.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  182.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  183.         REAL*8 SIGY(NSIGY)
  184.         INTEGER NKX(NNKX)
  185.       ENDSEGMENT
  186. *
  187.       SEGMENT WR10
  188.         INTEGER IABLO1(NTABO1)
  189.         REAL*8  TABLO2(NTABO2)
  190.       ENDSEGMENT
  191. *
  192.       SEGMENT WR11
  193.         INTEGER IABLO3(NTABO3)
  194.         REAL*8  TABLO4(NTABO4)
  195.       ENDSEGMENT
  196. *
  197.       SEGMENT WTRAV
  198.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  199.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  200.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  201.         REAL*8 XLOC(3,3),XGLOB(3,3)
  202.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  203.       ENDSEGMENT
  204. *
  205.       SEGMENT WPOUT
  206.          REAL*8  X(2),Y(2),Z(2)
  207.       ENDSEGMENT
  208. *
  209.       SEGMENT DRA0
  210.         REAL*8 AAA(LDRA0)
  211.       ENDSEGMENT
  212.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  213.       LOGICAL LUNI1,LUNI2
  214.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  215. *
  216.       CHARACTER*72 CHARRE
  217.       CHARACTER*8  CMATE
  218. c
  219. *
  220. *   mise à disposition des temperatures tini tfin tref
  221. *   aux points de gauss
  222. *
  223.          TETA1=-1.E35
  224.          TETA2=-1.E35
  225.          TETREF=-1.E35
  226.          TREFA=-1.E35
  227.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  228.             MCHAM3=IPH1
  229.             MCHAM4=IPH2
  230.             MCHAM5=IPH3
  231.             SEGACT MCHAM3
  232.             SEGACT MCHAM4
  233.             SEGACT MCHAM5
  234.             MELVA3=MCHAM3.IELVAL(1)
  235.             MELVA4=MCHAM4.IELVAL(1)
  236.             MELVA5=MCHAM5.IELVAL(1)
  237.             SEGACT MELVA3
  238.             SEGACT MELVA4
  239.             SEGACT MELVA5
  240.          ENDIF
  241. c
  242. c
  243. c   Initialisations de variables
  244. c---------------------------------
  245. c      - mise à zéro des variables du commun NECOU si besoin
  246. c      - modèles viscoplastiques:
  247. c                  . on récupère le pas de temps
  248. c                  . on récupère le nombre maximal de sous-pas
  249. c                  . on met IND=1
  250. c      - initialisation des dimensions des tableaux des segments
  251. c   Sorties: en plus du commun NECOU, on range les autres données
  252. c   initialisées dans les COMMON IECOU et XECOU
  253. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  254. c   argument de DEFINI
  255. c
  256.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  257.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  258.      .           IPMAIL,IVAMAT,
  259.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  260.      .           LUNI1,LUNI2,LW,KERRE)
  261.       IF (KERRE.EQ.999) RETURN
  262. c
  263. c  Initialisations des segments de travail
  264. c
  265.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  266.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  267.      1     .OR.MFR.EQ.33)) THEN
  268.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  269.         MINTE2=IPTR1
  270.         SEGACT MINTE2
  271.         SEGINI WRK22
  272.       ENDIF
  273. c
  274.       IF (LOGVIS) SEGINI WRK8
  275. *
  276.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  277.       IF (INPLAS.EQ.51) SEGINI ENDO0
  278.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  279.          SEGINI WRK4
  280.       ENDIF
  281. c
  282.       SEGINI WTRAV
  283.       IF (INPLAS.EQ.75) THEN
  284.          LDRA0=951
  285.          SEGINI DRA0
  286.       ENDIF
  287. *
  288. *
  289. *       boucle sur les elements
  290. *
  291.       DO 1000 IB=1,NBELEM
  292. *
  293. *  Matériaux orthotropes, anisotropes et unidirectionnels
  294. *  en formulation massive:
  295. *     - on cherche  les coordonnees des noeuds de l element ib
  296. *     - calcul des axes locaux
  297. *  Cas particulier de l'ACIER_UNI
  298. *
  299.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  300.      .     MELEME,WRK4,WRK22,WTRAV)
  301. *
  302. *
  303. *       boucle sur les points de gauss
  304. *
  305.          DO 1100 IGAU=1,NBPTEL
  306. *
  307. *  -recuperation de valmat et de valcar
  308. *  -on recupere les contraintes initiales
  309. *  -on recupere les variables internes
  310. *  -on recupere les deformations inelastiques initiales si besoin
  311. *  -on recupere les increments de deformations totales
  312. *  -on cherche la section de l'element ib
  313. *  -prise en compte de l'epaisseur et de l'excentrement
  314. *  dans le cas des coques minces avec ou sans cisaillement
  315. *  transverse
  316. *
  317.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  318.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  319.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  320.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  321. *
  322. *     on recupere les constantes du materiau
  323. *     calcul des contraintes effectives en milieu poreux
  324. *
  325.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  326.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  327.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  328.      .        BID,BID2,KERR0)
  329.       IF (KERR0.EQ.99) THEN
  330.          KERRE=99
  331.          GOTO 1000
  332.       ELSE IF (KERR0.EQ.10) THEN
  333.          GOTO 1000
  334.       ENDIF
  335. *
  336. * >>>>>>>>>>   fin du traitement du materiau
  337. *
  338. *        on recupere les caracteristiques geometriques
  339. *
  340.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  341.      .           WRK1)
  342. *
  343. *
  344. *          quelques impressions si iimpi = 99
  345. *
  346. *      IF(IIMPI.EQ.99) THEN
  347. *         WRITE(IOIMP,66770) IB,IGAU
  348. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  349. *         WRITE(IOIMP,66771) MATE,INPLAS
  350. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  351. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  352. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  353. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  354. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  355. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  356. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  357. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  358. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  359. *         IF(IVACAR.NE.0)THEN
  360. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  361. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  362. *         ENDIF
  363. *      ENDIF
  364. *
  365. *   mise à disposition des temperatures tini tfin tref
  366. *   aux points de gauss
  367. *
  368.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  369.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  370.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  371.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  372.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  373.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  374.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  375.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  376.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  377.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  378.          ENDIF
  379. *
  380. *
  381. *---------------------------------------------------------------------
  382. *
  383. *                  ecoulement selon les modeles
  384. *
  385. *---------------------------------------------------------------------
  386. *
  387. c
  388. c
  389. c     modeles implantes dans ecoinc
  390. c
  391.                IF (INPLAS.EQ.51) THEN
  392. c
  393. c   cas de la plasticite isotrope ecrouissable avec un
  394. c   endommagement de type P/Y
  395. c
  396. c on recupere la courbe de traction et la courbe de début d'endommagement
  397. c
  398.                CALL COEND(WRK0,WRK2,ENDO0,NCOURB,NENDO,
  399.      1                    NRAPP,KERRE)
  400.                INPLS0 = 5
  401.                IF (VAR0(7).GE.1.D-10) THEN
  402.                  DO 110 I=1,NSTRS
  403.                     SIG0(I)=SIG0(I)/VAR0(7)
  404.  110             CONTINUE
  405.                ENDIF
  406. c
  407. c  calcul des contraintes plastiquement admissibles
  408. c
  409.                IF (KERRE .EQ. 0) THEN
  410.                   DO 1114 IC=1,ICARA
  411.                      WORK(IC)=XCAR(IC)
  412. 1114              continue
  413.                   BID(1)=0.D00
  414.                   BID(2)=0.D00
  415.                   BID(3)=0.D00
  416.                   mfr1=mfr
  417.                   CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  418.      1            N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  419.      2            SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  420.      3            NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  421.      4            XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLS0)
  422.                END IF
  423. c
  424. c  retour au modèle d'endommagement P/Y
  425. c
  426. c  calcul des contraintes endommagées
  427. c
  428.                CALL PSURY(ENDO,NENDO,NVARI,NSTRSS,MFR1,DEPST,XMAT,VAR0,
  429.      1              RAPP,NRAPP,
  430.      1              SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  431. c
  432. c
  433.             ELSE IF (INPLAS.EQ.62) THEN
  434. c
  435. c  Modèle d'endommagement de Rousselier
  436. c   - on recupère la courbe de traction
  437. c
  438.               CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  439. c
  440. c   - appel au modèle
  441. C
  442.               IF(KERRE.EQ.0) THEN
  443.                   inecou=0
  444.                   CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,
  445.      1            DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  446.      2            SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  447.                   IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  448.                      KERR1=1
  449.                   ENDIF
  450.               ENDIF
  451. c
  452. c
  453.             ELSE IF (INPLAS.EQ.64) THEN
  454. c
  455. c  Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  456. c   - on recupère la courbe de traction
  457. c
  458.        CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  459. c
  460. c   - appel au modèle
  461. c
  462.               IF(KERRE.EQ.0) THEN
  463.                   inecou=0
  464.                   CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,
  465.      1            DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  466.      2            SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  467.                   IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  468.                      KERR1=1
  469.                   END IF
  470.               ENDIF
  471. c
  472. c
  473.             ELSE IF (INPLAS.EQ.75) THEN
  474. c
  475. c  Modèle d'endommagement de Dragon
  476. c
  477.          CALL DRAGON(WRK0,WRK1,WRK5,DRA0,KERRE)
  478. c
  479. c
  480.             ELSE
  481.                KERRE = 99
  482.             ENDIF
  483. *
  484. *   Erreurs
  485. *      - problèmes de convergence
  486. *
  487.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  488. *
  489. *      - autres problèmes
  490. *
  491.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  492.      .           KERR1,KERRE)
  493.  1998 IF (KERRE.NE.0) THEN
  494.          IF (LOGVIS) SEGSUP WRK8
  495.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  496.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  497.             SEGSUP WRK4
  498.          ENDIF
  499.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  500.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  501.      1     .OR.MFR.EQ.33)) THEN
  502.            SEGDES MINTE2
  503.            SEGSUP WRK22
  504.          ENDIF
  505.          IF (INPLAS.EQ.51) SEGSUP ENDO0
  506.          IF (INPLAS.EQ.75) SEGSUP DRA0
  507.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  508.             SEGDES MELVA3
  509.             SEGDES MELVA4
  510.             SEGDES MELVA5
  511.             SEGDES MCHAM3
  512.             SEGDES MCHAM4
  513.             SEGDES MCHAM5
  514.          ENDIF
  515.          RETURN
  516.       ENDIF
  517. *
  518. c
  519. c     remplissage du segment contenant les contraintes a la fin
  520. *     ( rearrangement pour milieu poreux ),
  521. c     les variables internes finales
  522. c     et les increments de deformations plastiques
  523. c
  524.       CALL DEFSIG(MFR,NDEF,
  525.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  526.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  527.      .     CMATE,MATE,MELE,KERRER)
  528.       IF (KERRER.NE.0) GOTO 1000
  529. c
  530. c
  531. c    fin de la boucle sur les points de gauss
  532. c
  533. 1100     continue
  534. c
  535. c    special poutres et tuyaux  sauf timoschenko
  536. c
  537.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  538. c
  539. c     fin de la boucle sur les elements
  540. c
  541. 1000  continue
  542. c
  543. *  FIN: modèles visqueux, on stocke le pas de temps
  544. *  optimal en indice 'dtopti'
  545. *
  546.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  547.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  548.       IF (LOGVIS) SEGSUP WRK8
  549. *
  550. *
  551.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  552.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  553.          SEGSUP WRK4
  554.       END IF
  555.       IF (INPLAS.EQ.51) SEGSUP ENDO0
  556.       IF (INPLAS.EQ.75) SEGSUP DRA0
  557.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  558.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  559.      1     .OR.MFR.EQ.33)) THEN
  560.         SEGDES MINTE2
  561.         SEGSUP WRK22
  562.       ENDIF
  563. *
  564.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  565.             SEGDES MELVA3
  566.             SEGDES MELVA4
  567.             SEGDES MELVA5
  568.             SEGDES MCHAM3
  569.             SEGDES MCHAM4
  570.             SEGDES MCHAM5
  571.       ENDIF
  572. *
  573.       RETURN
  574.       END
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  

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