Télécharger la plaquette Cast3M


fr en

Télécharger ecou10.eso

Retour à la liste

Numérotation des lignes : 

ecou10

  1. C ECOU10    SOURCE    OF166741  25/11/04    21:15:46     12349          
  2.       SUBROUTINE ECOU10(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. *      MATERIAUX: - ELASTIQUES LINEAIRES
  11. *                 - PLASTIQUES INTEGRES PAR CONSTI
  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 inela.
  28. *  ivadet =pointeur sur un segment mptval de deformations totales
  29. *  ivads  =pointeur sur un segment mptval de contraintes  (increments)
  30. *  ivamat =pointeur sur un segment mptval de materiau
  31. *  ivacar =pointeur sur un segment mptval de cacarteristiques geometrique
  32. *  iph1  = pointeur sur un mchaml de temperatures au debut du pas
  33. *  iph2  = pointeur sur un mchaml de temperatures a la fin du pas
  34. *  iph3  = pointeur sur un mchaml de temperatures de reference
  35. *  ithher = 0 si pas de chargement thermique
  36. *         = 1 si chargement thermique mais materiau constant
  37. *         = 2 si chargement thermique et mat. dependant de la temperature
  38. *  ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  39. *        endommageables de lemaitre quand ils dependent de la temperature
  40. *  lhook  =taille de la matrice de hooke
  41. *  nstrs  =nombre de composantes de contraintes
  42. *  nvari  =nombre de composantes de variables internes
  43. *  nmatt  =nombre de composnates de proprietes de materiau
  44. *  ncarr  =nombre de composnates de caracteristiques geometriques
  45. *  cmate  =nom du materiau
  46. *  precis =precision dans les iterations internes
  47. *  jecher =0 ou 1 pour action dans ecoule
  48. *  jnoid  =0 ou 1 pour action dans ecoule
  49. *  ipotab =pointeur sur segment table
  50. *  istep  =indicateur d'action pour calcul nonlocal
  51. *        =0 dans le cas d'un calcul local (normal)
  52. *        =1 ou 2 dans le cas d'un calcul nonlocal
  53. *        =1 pour calcul des fonctions seuil uniquement
  54. *        =2 pour calcul des variables dissipatives a partir
  55. *           des fonctions seuil moyennees prealablement par nloc
  56. *
  57. * sorties :
  58. *  ivastf  =pointeur sur un segment mptval de contraintes
  59. *  ivarif  =pointeur sur un segment mptval de variables internes
  60. *  ivadep  =pointeur sur un segment mptval de deformations inelastiques
  61. *  kerre   =indicateur d'erreur
  62. *
  63. *  p dowlatyari  fev. 1992
  64. *
  65. *  c. la borderie fev 92 restructuration et reecriture de certains
  66. *                        passages pour une meilleure lisibilite
  67. *
  68. *                 avril 92 ajout istep pour le non local
  69. *                 dec 92 modif pour poutres timoschenko
  70. *
  71. ************************************************************************
  72.       IMPLICIT INTEGER(I-N)
  73.       IMPLICIT REAL*8(A-H,O-Z)
  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 WRK0
  121.        REAL*8 XMAT(NCXMAT)
  122.       ENDSEGMENT
  123. *
  124.       SEGMENT WR00
  125.        CHARACTER*16 TYMAT(NCXMAT)
  126.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  127.       ENDSEGMENT
  128. *
  129.       SEGMENT WRK1
  130.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  131.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  132.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  133.       ENDSEGMENT
  134. *
  135.       SEGMENT WRK2
  136.         REAL*8 TRAC(LTRAC)
  137.       ENDSEGMENT
  138. *
  139.       SEGMENT WRK22
  140.       REAL*8 XXE(3,NBNN)
  141.       ENDSEGMENT
  142. *
  143.       SEGMENT WRK3
  144.         REAL*8 WORK(LW),WORK2(LW2)
  145.       ENDSEGMENT
  146. *
  147.       SEGMENT WRK4
  148.         REAL*8 XE(3,NBNN)
  149.       ENDSEGMENT
  150. *
  151.       SEGMENT WRK5
  152.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  153.       ENDSEGMENT
  154. *
  155.       SEGMENT WRK6
  156.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  157.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  158.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  159.       ENDSEGMENT
  160. *
  161.       SEGMENT WRK7
  162.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  163.       ENDSEGMENT
  164. *
  165.       SEGMENT WRK8
  166.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  167.       ENDSEGMENT
  168. *
  169.       SEGMENT WRK9
  170.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  171.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  172.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  173.         REAL*8 SIGY(NSIGY)
  174.         INTEGER NKX(NNKX)
  175.       ENDSEGMENT
  176. *
  177.       SEGMENT WR10
  178.         INTEGER IABLO1(NTABO1)
  179.         REAL*8  TABLO2(NTABO2)
  180.       ENDSEGMENT
  181. *
  182.       SEGMENT WR11
  183.         INTEGER IABLO3(NTABO3)
  184.         REAL*8  TABLO4(NTABO4)
  185.       ENDSEGMENT
  186. *
  187.       SEGMENT WTRAV
  188.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  189.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  190.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  191.         REAL*8 XLOC(3,3),XGLOB(3,3)
  192.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  193.       ENDSEGMENT
  194. *
  195.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  196.       LOGICAL LUNI1,LUNI2
  197.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  198. *
  199.       CHARACTER*72 CHARRE
  200.       CHARACTER*8  CMATE
  201. *
  202. *   mise à disposition des temperatures tini tfin tref
  203. *   aux points de gauss
  204. *
  205.       TETA1=-1.E35
  206.       TETA2=-1.E35
  207.       TETREF=-1.E35
  208.       TREFA=-1.E35
  209.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  210.          MCHAM3=IPH1
  211.          MCHAM4=IPH2
  212.          MCHAM5=IPH3
  213.          SEGACT MCHAM3,MCHAM4,MCHAM5
  214.          MELVA3=MCHAM3.IELVAL(1)
  215.          MELVA4=MCHAM4.IELVAL(1)
  216.          MELVA5=MCHAM5.IELVAL(1)
  217.          SEGACT MELVA3,MELVA4,MELVA5
  218.       ENDIF
  219. c
  220. c   Initialisations de variables
  221. c---------------------------------
  222. c      - mise à zéro des variables du commun NECOU si besoin
  223. c      - modèles viscoplastiques:
  224. c                  . on récupère le pas de temps
  225. c                  . on récupère le nombre maximal de sous-pas
  226. c                  . on met IND=1
  227. c      - initialisation des dimensions des tableaux des segments
  228. c   Sorties: en plus du commun NECOU, on range les autres données
  229. c   initialisées dans les COMMON IECOU et XECOU
  230. c   Sauf pour KERRE,LOGVIS,LW,LUNI1 et LUNI2 qui sont sortis comme
  231. c   argument de DEFINI
  232. c
  233.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  234.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  235.      .           IPMAIL,IVAMAT,
  236.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  237.      .           LUNI1,LUNI2,LW,KERRE)
  238.       IF (KERRE.EQ.999) RETURN
  239. c
  240. c  Initialisations des segments de travail
  241. c
  242.       IPTR1 = 0
  243.       WRK22 = 0
  244.       wrk4 = 0
  245.       wrk8 = 0
  246.  
  247.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  248.  
  249.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  250.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  251.      1     .OR.MFR.EQ.33)) THEN
  252.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  253.         MINTE2=IPTR1
  254. c*        SEGACT,minte2 <- cree par reshpt et actif
  255.         SEGINI WRK22
  256.       ENDIF
  257.       IF (LOGVIS) SEGINI WRK8
  258.       IF (MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  259.         SEGINI WRK4
  260.       ENDIF
  261. *
  262. *       boucle sur les elements
  263. *
  264.       DO 1000 IB=1,NBELEM
  265. *
  266. *  Matériaux orthotropes, anisotropes et unidirectionnels
  267. *  en formulation massive:
  268. *     - on cherche  les coordonnees des noeuds de l element ib
  269. *     - calcul des axes locaux
  270. *  Cas particulier de l'ACIER_UNI
  271. *
  272.         CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  273.      &              MELEME,WRK4,WRK22,WTRAV)
  274. *
  275. *       boucle sur les points de gauss
  276. *
  277.       DO 1100 IGAU=1,NBPTEL
  278. *
  279. *  -recuperation de valmat et de valcar
  280. *  -on recupere les contraintes initiales
  281. *  -on recupere les variables internes
  282. *  -on recupere les deformations inelastiques initiales si besoin
  283. *  -on recupere les increments de deformations totales
  284. *  -on cherche la section de l'element ib
  285. *  -prise en compte de l'epaisseur et de l'excentrement
  286. *  dans le cas des coques minces avec ou sans cisaillement
  287. *  transverse
  288. *
  289.         CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  290.      .       IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  291.      .       IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  292.      .       WTRAV,WRK1,WRK5,SECT,EPAIST)
  293. *
  294. *     on recupere les constantes du materiau
  295. *     calcul des contraintes effectives en milieu poreux
  296. *
  297.         CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  298.      .          IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  299.      .          WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  300.      .          BID,BID2,KERR0)
  301.         IF (KERR0.EQ.99) THEN
  302.            KERRE=99
  303.            GOTO 1000
  304.         ELSE IF (KERR0.EQ.10) THEN
  305.            GOTO 1000
  306.         ENDIF
  307. *
  308. * >>>>>>>>>>   fin du traitement du materiau
  309. *
  310. *        on recupere les caracteristiques geometriques
  311. *
  312.         CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, WRK1)
  313. *
  314. *          quelques impressions si iimpi = 99
  315. *
  316.        IF(IIMPI.EQ.99) THEN
  317.          WRITE(IOIMP,66770) IB,IGAU
  318. 66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  319.          WRITE(IOIMP,66771) MATE,INPLAS
  320. 66771    format('0  mate=',i4,2x,'inplas=',i4/)
  321.          WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  322. 66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  323.          WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  324. 66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  325.          WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  326. 66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  327.          WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  328. 66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  329.          IF(IVACAR.NE.0)THEN
  330.             WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  331. 66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  332.          ENDIF
  333.        ENDIF
  334. *
  335. *   mise à disposition des temperatures tini tfin tref
  336. *   aux points de gauss
  337. *
  338.         IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  339.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  340.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  341.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  342.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  343.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  344.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  345.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  346.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  347.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  348.         ENDIF
  349.  
  350. *---------------------------------------------------------------------
  351. *
  352. *                  ecoulement selon les modeles
  353. *
  354. *---------------------------------------------------------------------
  355. *
  356.         IF(INPLAS.EQ.0)THEN
  357. c
  358. c      modele elastique lineaire
  359. c
  360.           CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,
  361.      1      N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,
  362.      2      NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  363.      3                            ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  364.               IF(IRTD.EQ.1) THEN
  365.                 KERRE=69
  366.                 GOTO 1990
  367.               ENDIF
  368.               DO 1111 IC=1,NSTRSS
  369.                 IF(IND.EQ.1)THEN
  370.                   EPINF(IC)=0.D0
  371.                 ELSE
  372.                   DEFP(IC)=0.D0
  373.                 ENDIF
  374.                 SIGF(IC)=SIG0(IC)+DSIGT(IC)
  375. 1111          continue
  376.               DO 1112 IC=1,NVARI
  377.                 VARF(IC)=VAR0(IC)
  378. 1112          continue
  379. c
  380. c     modeles implantes dans ecoinc
  381. c
  382.         ELSE IF ( INPLAS .EQ. 1  .OR.
  383.      1                INPLAS .EQ. 3  .OR.
  384.      2                INPLAS .EQ. 4  .OR.
  385.      3                INPLAS .EQ. 5  .OR.
  386.      4                INPLAS .EQ. 7  .OR.
  387.      5                INPLAS .EQ. 12 .OR.
  388.      6                INPLAS .EQ. 15. OR. INPLAS.EQ.87 ) THEN
  389. c
  390. c     modele von mises isotrope associe ( d'apres inca )
  391. c
  392.                IF (INPLAS .EQ. 1) THEN
  393. c
  394. c    cas de la plasticite parfaite
  395. c
  396.                   NCOURB=2
  397.                   IF (MATE.EQ.4.AND.MFR.EQ.1.AND.IDIM.EQ.3) THEN
  398.                      TRAC(1)=XMAT(9)
  399.                      TRAC(3)=XMAT(9)
  400.                   ELSE
  401.                      TRAC(1)=XMAT(5)
  402.                      TRAC(3)=XMAT(5)
  403.                   ENDIF
  404.                   TRAC(2)=0.D0
  405.                   TRAC(4)=1.D9
  406.                   IF((IDIM.EQ.2.AND.XMAT(5).EQ.0.D0).OR.
  407.      +               (MATE.EQ.4.AND.MFR.EQ.1.AND.IDIM.EQ.
  408.      +                3.AND.XMAT(9).EQ.0.D0)) THEN
  409.                      KERRE = 33
  410.                   ELSE
  411.                      KERRE = 0
  412.                   ENDIF
  413. c
  414.                ELSE IF (INPLAS .EQ. 3) THEN
  415. c
  416. c    cas du modele de drucker-prager parfait
  417. c    les donnees sont les limites en traction et en compression
  418. c
  419.                   IMAPLA=5
  420.                   DEN =  ABS(XMAT(6)) + XMAT(5)
  421.                   IF(DEN.EQ.0.D0) THEN
  422.                      KERRE=48
  423.                   ELSE
  424.                      XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  425.                      XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  426.                      XMAT(6) = 1.D0
  427.                      XMAT(8)=XMAT(5)
  428.                      XMAT(9)=XMAT(6)
  429.                      XMAT(10)=XMAT(5)
  430.                      XMAT(11)=XMAT(6)
  431.                      XMAT(12)=XMAT(7)
  432.                      XMAT(13)=0.D0
  433. c
  434. c          petits tests sur les donnees
  435.                      IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  436.      &                   XMAT(5)*1.01/(XMAT(6)+1.D-20)
  437.      &                  .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  438.                         KERRE = 48
  439.                      ELSE
  440.                         KERRE = 0
  441.                      ENDIF
  442.                   END IF
  443.                ELSE IF (INPLAS .EQ. 4) THEN
  444. c
  445. c    cas de la plasticite cinematique bilineaire
  446. c
  447.                   IF(XMAT(5).EQ.0.D0) THEN
  448.                      KERRE=33
  449.                   ELSE
  450.                      ICINE=1
  451.                      NCOURB=2
  452.                      TRAC(1)=XMAT(5)
  453.                      TRAC(2)=0.D0
  454.                      TRAC(4)=1.D9
  455.                      TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4)
  456.                   END IF
  457.                ELSE IF (INPLAS .EQ.  5 .OR.INPLAS.EQ.87) THEN
  458. c
  459. c   cas de la plasticite isotrope ecrouissable
  460. c
  461. c  on recupere la courbe de traction
  462. c
  463.                   CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  464.                ELSE IF (INPLAS .EQ.  7 ) THEN
  465. c
  466. c    cas du modele chaboche
  467. c
  468.                   KERRE = 0
  469.                   ICINE = 1
  470.                   IMAPLA= 4
  471. c
  472.                ELSE IF (INPLAS .EQ.  12) THEN
  473. c
  474. c    cas du modele chaboche
  475. c
  476.                   KERRE = 0
  477.                   ICINE = 1
  478.                   IMAPLA= 4
  479.                ELSE IF (INPLAS .EQ. 15 ) THEN
  480. c
  481. c    cas du modele de drucker-prager general
  482. c
  483.                   IMAPLA=5
  484. c
  485. c          petits tests sur les donnees
  486. c
  487.                   IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  488.      1                 XMAT(5)*1.01/(XMAT(6)+1.D-20)
  489.      2                .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  490.                      KERRE = 48
  491.                   ELSE
  492.                      KERRE = 0
  493. c
  494. c          permutations pour ecoinc
  495. c
  496.                      DO 1113 I=5,7
  497.                         WW=XMAT(I)
  498.                         XMAT(I)=XMAT(I+5)
  499.                         XMAT(I+5)=WW
  500. 1113                 continue
  501.                   END IF
  502. c
  503.                END IF
  504.                IF (KERRE .EQ. 0) THEN
  505.                   DO 1114 IC=1,ICARA
  506.                      WORK(IC)=XCAR(IC)
  507. 1114              continue
  508.                   BID(1)=0.D00
  509.                   BID(2)=0.D00
  510.                   BID(3)=0.D00
  511.  
  512.                   IF ((INPLAS .EQ. 1  .OR.
  513.      &                 INPLAS .EQ. 4  .OR.
  514.      &                 INPLAS .EQ. 5  .OR.
  515.      &                 INPLAS .EQ. 7  .OR.
  516.      &                 INPLAS .EQ. 12.OR.INPLAS.EQ.87 ) .AND.
  517.      &                (MFR .EQ. 1 .OR.
  518.      &                 MFR .EQ. 3 .OR.
  519.      &                 MFR .EQ. 5 .OR.
  520.      &                 MFR .EQ. 7 .OR.
  521.      &                 MFR .EQ. 9 )     .AND.
  522.      &                (CMATE.NE.'UNIDIREC')) THEN
  523.  
  524.                   CALL ECOIN0(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  525.      &                  N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  526.      &            SIGF,VARF,DEFP,KERRE,MFR1,IB,IGAU,NSTRSS,EPAIST,MELE,
  527.      &                   NPINT,NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
  528.      &     XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS,NCOURB,IFOURB)
  529.  
  530.                   ELSE
  531.  
  532.                   mfr=mfr1
  533.                   CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  534.      1                  N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  535.      2            SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  536.      3                   NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  537.      4                    XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS)
  538.  
  539.                   ENDIF
  540.  
  541.                END IF
  542. c
  543.             ELSE
  544.                KERRE = 99
  545.             ENDIF
  546. *
  547. *   Erreurs
  548. *      - problèmes de convergence
  549. *
  550.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  551. *
  552. *      - autres problèmes
  553. *
  554.  1990   CONTINUE
  555.         CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, KERR1,KERRE)
  556.         IF (KERRE.NE.0) GOTO 99
  557.  
  558. c     remplissage du segment contenant les contraintes a la fin
  559. *     ( rearrangement pour milieu poreux ),
  560. c     les variables internes finales
  561. c     et les increments de deformations plastiques
  562.  
  563.       CALL DEFSIG(MFR,NDEF,
  564.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  565.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  566.      .     CMATE,MATE,MELE,KERRER)
  567.       IF (KERRER.NE.0) GOTO 1000
  568. c
  569. c    fin de la boucle sur les points de gauss
  570. c
  571. 1100     continue
  572. c
  573. c    special poutres et tuyaux  sauf timoschenko
  574. c
  575.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  576. c
  577. c     fin de la boucle sur les elements
  578. c
  579. 1000  continue
  580. *
  581. *  FIN: modèles visqueux, on stocke le pas de temps
  582. *  optimal en indice 'dtopti'
  583. *
  584.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  585.      &            TCAR,DTOPTI,IPOTAB,KERRE)
  586.  
  587. *  Fin normale ou Erreur : menage dans les segments de travail
  588.  99   CONTINUE
  589.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  590.       IF (WRK4.NE.0) SEGSUP,WRK4
  591.       IF (WRK8.NE.0) SEGSUP,WRK8
  592.       IF (IPTR1.NE.0) THEN
  593.         SEGSUP,MINTE2
  594.         SEGSUP,WRK22
  595.       ENDIF
  596.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  597.         SEGDES,MELVA3,MELVA4,MELVA5
  598.         SEGDES,MCHAM3,MCHAM4,MCHAM5
  599.       ENDIF
  600.  
  601.       RETURN
  602.       END
  603.  
  604.  
  605.  

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