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    OF166741  25/02/21    21:16:05     12166          
  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. -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 ENDO0
  141.         REAL*8 ENDO(LENDO),RAPP(LENDO)
  142.       ENDSEGMENT
  143. *
  144.       SEGMENT WRK22
  145.       REAL*8 XXE(3,NBNN)
  146.       ENDSEGMENT
  147. *
  148.       SEGMENT WRK3
  149.         REAL*8 WORK(LW),WORK2(LW2)
  150.       ENDSEGMENT
  151. *
  152.       SEGMENT WRK4
  153.         REAL*8 XE(3,NBBB)
  154.       ENDSEGMENT
  155. *
  156.       SEGMENT WRK5
  157.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  158.       ENDSEGMENT
  159. *
  160.       SEGMENT WRK6
  161.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  162.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  163.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  164.       ENDSEGMENT
  165. *
  166.       SEGMENT WRK7
  167.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  168.       ENDSEGMENT
  169. *
  170.       SEGMENT WRK8
  171.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  172.       ENDSEGMENT
  173. *
  174.       SEGMENT WRK9
  175.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  176.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  177.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  178.         REAL*8 SIGY(NSIGY)
  179.         INTEGER NKX(NNKX)
  180.       ENDSEGMENT
  181. *
  182.       SEGMENT WR10
  183.         INTEGER IABLO1(NTABO1)
  184.         REAL*8  TABLO2(NTABO2)
  185.       ENDSEGMENT
  186. *
  187.       SEGMENT WR11
  188.         INTEGER IABLO3(NTABO3)
  189.         REAL*8  TABLO4(NTABO4)
  190.       ENDSEGMENT
  191. *
  192.       SEGMENT WTRAV
  193.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  194.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  195.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  196.         REAL*8 XLOC(3,3),XGLOB(3,3)
  197.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  198.       ENDSEGMENT
  199. *
  200.       SEGMENT WPOUT
  201.          REAL*8  X(2),Y(2),Z(2)
  202.       ENDSEGMENT
  203. *
  204.       SEGMENT DRA0
  205.         REAL*8 AAA(LDRA0)
  206.       ENDSEGMENT
  207.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  208.       LOGICAL LUNI1,LUNI2
  209.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  210. *
  211.       CHARACTER*72 CHARRE
  212.       CHARACTER*8  CMATE
  213. c
  214. *
  215. *   mise à disposition des temperatures tini tfin tref
  216. *   aux points de gauss
  217. *
  218.          TETA1=-1.E35
  219.          TETA2=-1.E35
  220.          TETREF=-1.E35
  221.          TREFA=-1.E35
  222.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  223.             MCHAM3=IPH1
  224.             MCHAM4=IPH2
  225.             MCHAM5=IPH3
  226.             SEGACT MCHAM3
  227.             SEGACT MCHAM4
  228.             SEGACT MCHAM5
  229.             MELVA3=MCHAM3.IELVAL(1)
  230.             MELVA4=MCHAM4.IELVAL(1)
  231.             MELVA5=MCHAM5.IELVAL(1)
  232.             SEGACT MELVA3
  233.             SEGACT MELVA4
  234.             SEGACT MELVA5
  235.          ENDIF
  236. c
  237. c
  238. c   Initialisations de variables
  239. c---------------------------------
  240. c      - mise à zéro des variables du commun NECOU si besoin
  241. c      - modèles viscoplastiques:
  242. c                  . on récupère le pas de temps
  243. c                  . on récupère le nombre maximal de sous-pas
  244. c                  . on met IND=1
  245. c      - initialisation des dimensions des tableaux des segments
  246. c   Sorties: en plus du commun NECOU, on range les autres données
  247. c   initialisées dans les COMMON IECOU et XECOU
  248. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  249. c   argument de DEFINI
  250. c
  251.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  252.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  253.      .           IPMAIL,IVAMAT,
  254.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  255.      .           LUNI1,LUNI2,LW,KERRE)
  256.       IF (KERRE.EQ.999) RETURN
  257. c
  258. c  Initialisations des segments de travail
  259. c
  260.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  261.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  262.      1     .OR.MFR.EQ.33)) THEN
  263.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  264.         MINTE2=IPTR1
  265.         SEGACT MINTE2
  266.         SEGINI WRK22
  267.       ENDIF
  268. c
  269.       IF (LOGVIS) SEGINI WRK8
  270. *
  271.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  272.       IF (INPLAS.EQ.51) SEGINI ENDO0
  273.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  274.          SEGINI WRK4
  275.       ENDIF
  276. c
  277.       SEGINI WTRAV
  278.       IF (INPLAS.EQ.75) THEN
  279.          LDRA0=951
  280.          SEGINI DRA0
  281.       ENDIF
  282. *
  283. *       boucle sur les elements
  284. *
  285.       DO 1000 IB=1,NBELEM
  286. *
  287. *  Matériaux orthotropes, anisotropes et unidirectionnels
  288. *  en formulation massive:
  289. *     - on cherche  les coordonnees des noeuds de l element ib
  290. *     - calcul des axes locaux
  291. *  Cas particulier de l'ACIER_UNI
  292. *
  293.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  294.      .     MELEME,WRK4,WRK22,WTRAV)
  295. *
  296. *       boucle sur les points de gauss
  297. *
  298.          DO 1100 IGAU=1,NBPTEL
  299. *
  300. *  -recuperation de valmat et de valcar
  301. *  -on recupere les contraintes initiales
  302. *  -on recupere les variables internes
  303. *  -on recupere les deformations inelastiques initiales si besoin
  304. *  -on recupere les increments de deformations totales
  305. *  -on cherche la section de l'element ib
  306. *  -prise en compte de l'epaisseur et de l'excentrement
  307. *  dans le cas des coques minces avec ou sans cisaillement
  308. *  transverse
  309. *
  310.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  311.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  312.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  313.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  314. *
  315. *     on recupere les constantes du materiau
  316. *     calcul des contraintes effectives en milieu poreux
  317. *
  318.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  319.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  320.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  321.      .        BID,BID2,KERR0)
  322.       IF (KERR0.EQ.99) THEN
  323.          KERRE=99
  324.          GOTO 1000
  325.       ELSE IF (KERR0.EQ.10) THEN
  326.          GOTO 1000
  327.       ENDIF
  328. *
  329. * >>>>>>>>>>   fin du traitement du materiau
  330. *
  331. *        on recupere les caracteristiques geometriques
  332. *
  333.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  334.      .           WRK1)
  335. *
  336. *
  337. *          quelques impressions si iimpi = 99
  338. *
  339. *      IF(IIMPI.EQ.99) THEN
  340. *         WRITE(IOIMP,66770) IB,IGAU
  341. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  342. *         WRITE(IOIMP,66771) MATE,INPLAS
  343. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  344. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  345. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  346. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  347. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  348. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  349. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  350. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  351. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  352. *         IF(IVACAR.NE.0)THEN
  353. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  354. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  355. *         ENDIF
  356. *      ENDIF
  357. *
  358. *   mise à disposition des temperatures tini tfin tref
  359. *   aux points de gauss
  360. *
  361.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  362.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  363.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  364.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  365.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  366.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  367.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  368.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  369.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  370.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  371.          ENDIF
  372. *
  373. *---------------------------------------------------------------------
  374. *
  375. *                  ecoulement selon les modeles
  376. *
  377. *---------------------------------------------------------------------
  378. c
  379. c     modeles implantes dans ecoinc
  380. c
  381.                IF (INPLAS.EQ.51) THEN
  382. c
  383. c   cas de la plasticite isotrope ecrouissable avec un
  384. c   endommagement de type P/Y
  385. c
  386. c on recupere la courbe de traction et la courbe de début d'endommagement
  387. c
  388.                CALL COEND(WRK0,WRK2,ENDO0,NCOURB,NENDO,
  389.      1                    NRAPP,KERRE)
  390.                INPLS0 = 5
  391.                IF (VAR0(7).GE.1.D-10) THEN
  392.                  DO 110 I=1,NSTRS
  393.                     SIG0(I)=SIG0(I)/VAR0(7)
  394.  110             CONTINUE
  395.                ENDIF
  396. c
  397. c  calcul des contraintes plastiquement admissibles
  398. c
  399.                IF (KERRE .EQ. 0) THEN
  400.                   DO 1114 IC=1,ICARA
  401.                      WORK(IC)=XCAR(IC)
  402. 1114              continue
  403.                   BID(1)=0.D00
  404.                   BID(2)=0.D00
  405.                   BID(3)=0.D00
  406.                   mfr1=mfr
  407.                   CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  408.      1            N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  409.      2            SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  410.      3            NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  411.      4            XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLS0)
  412.                END IF
  413. c
  414. c  retour au modèle d'endommagement P/Y
  415. c
  416. c  calcul des contraintes endommagées
  417. c
  418.                CALL PSURY(ENDO,NENDO,NVARI,NSTRSS,MFR1,DEPST,XMAT,VAR0,
  419.      1              RAPP,NRAPP,
  420.      1              SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  421. c
  422.             ELSE IF (INPLAS.EQ.62) THEN
  423. c
  424. c  Modèle d'endommagement de Rousselier
  425. c   - on recupère la courbe de traction
  426. c
  427.               CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  428. c
  429. c   - appel au modèle
  430. C
  431.               IF(KERRE.EQ.0) THEN
  432.                   inecou=0
  433.                   CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,
  434.      1            DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  435.      2            SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  436.                   IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  437.                      KERR1=1
  438.                   ENDIF
  439.               ENDIF
  440. c
  441.             ELSE IF (INPLAS.EQ.64) THEN
  442. c
  443. c  Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  444. c   - on recupère la courbe de traction
  445. c
  446.        CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  447. c
  448. c   - appel au modèle
  449. c
  450.               IF(KERRE.EQ.0) THEN
  451.                   inecou=0
  452.                   CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,
  453.      1            DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  454.      2            SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  455.                   IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  456.                      KERR1=1
  457.                   END IF
  458.               ENDIF
  459. c
  460.             ELSE IF (INPLAS.EQ.75) THEN
  461. c
  462. c  Modèle d'endommagement de Dragon
  463. c
  464.          CALL DRAGON(WRK0,WRK1,WRK5,DRA0,KERRE)
  465. c
  466.             ELSE
  467.                KERRE = 99
  468.             ENDIF
  469. *
  470. *   Erreurs
  471. *      - problèmes de convergence
  472. *
  473.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  474. *
  475. *      - autres problèmes
  476. *
  477.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  478.      .           KERR1,KERRE)
  479.  1998 IF (KERRE.NE.0) THEN
  480.          IF (LOGVIS) SEGSUP WRK8
  481.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  482.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  483.             SEGSUP WRK4
  484.          ENDIF
  485.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  486.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  487.      1     .OR.MFR.EQ.33)) THEN
  488.            SEGDES MINTE2
  489.            SEGSUP WRK22
  490.          ENDIF
  491.          IF (INPLAS.EQ.51) SEGSUP ENDO0
  492.          IF (INPLAS.EQ.75) SEGSUP DRA0
  493.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  494.             SEGDES MELVA3
  495.             SEGDES MELVA4
  496.             SEGDES MELVA5
  497.             SEGDES MCHAM3
  498.             SEGDES MCHAM4
  499.             SEGDES MCHAM5
  500.          ENDIF
  501.          RETURN
  502.       ENDIF
  503. *
  504. c     remplissage du segment contenant les contraintes a la fin
  505. *     ( rearrangement pour milieu poreux ),
  506. c     les variables internes finales
  507. c     et les increments de deformations plastiques
  508. c
  509.       CALL DEFSIG(MFR,NDEF,
  510.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  511.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  512.      .     CMATE,MATE,MELE,KERRER)
  513.       IF (KERRER.NE.0) GOTO 1000
  514. c
  515. c    fin de la boucle sur les points de gauss
  516. c
  517. 1100     continue
  518. c
  519. c    special poutres et tuyaux  sauf timoschenko
  520. c
  521.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  522. c
  523. c     fin de la boucle sur les elements
  524. c
  525. 1000  continue
  526. c
  527. *  FIN: modèles visqueux, on stocke le pas de temps
  528. *  optimal en indice 'dtopti'
  529. *
  530.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  531.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  532.       IF (LOGVIS) SEGSUP WRK8
  533. *
  534.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  535.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  536.          SEGSUP WRK4
  537.       END IF
  538.       IF (INPLAS.EQ.51) SEGSUP ENDO0
  539.       IF (INPLAS.EQ.75) SEGSUP DRA0
  540.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  541.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  542.      1     .OR.MFR.EQ.33)) THEN
  543.         SEGDES MINTE2
  544.         SEGSUP WRK22
  545.       ENDIF
  546. *
  547.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  548.             SEGDES MELVA3
  549.             SEGDES MELVA4
  550.             SEGDES MELVA5
  551.             SEGDES MCHAM3
  552.             SEGDES MCHAM4
  553.             SEGDES MCHAM5
  554.       ENDIF
  555. *
  556.       RETURN
  557.       END
  558.  
  559.  
  560.  

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