Télécharger la plaquette Cast3M


fr en

Télécharger ecou29.eso

Retour à la liste

Numérotation des lignes : 

ecou29

  1. C ECOU29    SOURCE    CB215821  24/04/12    21:15:42     11897          
  2.       SUBROUTINE ECOU29(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 DE LEMAITRE
  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 WRK22
  146.       REAL*8 XXE(3,NBNN)
  147.       ENDSEGMENT
  148. *
  149.       SEGMENT WRK3
  150.         REAL*8 WORK(LW),WORK2(LW2)
  151.       ENDSEGMENT
  152. *
  153.       SEGMENT WRK4
  154.         REAL*8 XE(3,NBBB)
  155.       ENDSEGMENT
  156. *
  157.       SEGMENT WRK5
  158.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  159.       ENDSEGMENT
  160. *
  161.       SEGMENT WRK6
  162.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  163.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  164.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS)
  165.       ENDSEGMENT
  166. *
  167.       SEGMENT WRK7
  168.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  169.       ENDSEGMENT
  170. *
  171.       SEGMENT WRK8
  172.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  173.       ENDSEGMENT
  174. *
  175.       SEGMENT WRK9
  176.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  177.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  178.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  179.         REAL*8 SIGY(NSIGY)
  180.         INTEGER NKX(NNKX)
  181.       ENDSEGMENT
  182. *
  183.       SEGMENT WR10
  184.         INTEGER IABLO1(NTABO1)
  185.         REAL*8  TABLO2(NTABO2)
  186.       ENDSEGMENT
  187. *
  188.       SEGMENT WR11
  189.         INTEGER IABLO3(NTABO3)
  190.         REAL*8  TABLO4(NTABO4)
  191.       ENDSEGMENT
  192. *
  193.       SEGMENT WTRAV
  194.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  195.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  196.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  197.         REAL*8 XLOC(3,3),XGLOB(3,3)
  198.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  199.       ENDSEGMENT
  200. *
  201.       SEGMENT WPOUT
  202.          REAL*8  X(2),Y(2),Z(2)
  203.       ENDSEGMENT
  204. *
  205.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  206.       LOGICAL LUNI1,LUNI2
  207.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  208. *
  209.       CHARACTER*72 CHARRE
  210.       CHARACTER*8  CMATE
  211. *
  212. *
  213. *   mise à disposition des temperatures tini tfin tref
  214. *   aux points de gauss
  215. *
  216.          TETA1=-1.E35
  217.          TETA2=-1.E35
  218.          TETREF=-1.E35
  219.          TREFA=-1.E35
  220.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  221.             MCHAM3=IPH1
  222.             MCHAM4=IPH2
  223.             MCHAM5=IPH3
  224.             SEGACT MCHAM3
  225.             SEGACT MCHAM4
  226.             SEGACT MCHAM5
  227.             MELVA3=MCHAM3.IELVAL(1)
  228.             MELVA4=MCHAM4.IELVAL(1)
  229.             MELVA5=MCHAM5.IELVAL(1)
  230.             SEGACT MELVA3
  231.             SEGACT MELVA4
  232.             SEGACT MELVA5
  233.          ENDIF
  234. c
  235. c   Initialisations de variables
  236. c---------------------------------
  237. c      - mise à zéro des variables du commun NECOU si besoin
  238. c      - modèles viscoplastiques:
  239. c                  . on récupère le pas de temps
  240. c                  . on récupère le nombre maximal de sous-pas
  241. c                  . on met IND=1
  242. c      - initialisation des dimensions des tableaux des segments
  243. c   Sorties: en plus du commun NECOU, on range les autres données
  244. c   initialisées dans les COMMON IECOU et XECOU
  245. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  246. c   argument de DEFINI
  247. c
  248.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  249.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  250.      .           IPMAIL,IVAMAT,
  251.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  252.      .           LUNI1,LUNI2,LW,KERRE)
  253.       IF (KERRE.EQ.999) RETURN
  254. c
  255. c  Initialisations des segments de travail
  256. c
  257.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  258.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  259.      1     .OR.MFR.EQ.33)) THEN
  260.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  261.         MINTE2=IPTR1
  262.         SEGACT MINTE2
  263.         SEGINI WRK22
  264.       ENDIF
  265. c
  266.       IF (LOGVIS) SEGINI WRK8
  267. *
  268. *    initialisation des segments de travail
  269. *
  270.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  271.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  272.          SEGINI WRK4
  273.       ENDIF
  274.       IF(INPLAS.EQ.26)THEN
  275.         SEGINI WRK6
  276.       ENDIF
  277. c
  278.       SEGINI WTRAV
  279. *
  280. *
  281. *       boucle sur les elements
  282. *
  283.       DO 1000 IB=1,NBELEM
  284. *
  285. *  Matériaux orthotropes, anisotropes et unidirectionnels
  286. *  en formulation massive:
  287. *     - on cherche  les coordonnees des noeuds de l element ib
  288. *     - calcul des axes locaux
  289. *  Cas particulier de l'ACIER_UNI
  290. *
  291.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  292.      .     MELEME,WRK4,WRK22,WTRAV)
  293. *
  294. *
  295. *       boucle sur les points de gauss
  296. *
  297.          DO 1100 IGAU=1,NBPTEL
  298.  
  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.           IF ((INPLAS.EQ.29.).OR.(INPLAS.EQ.26)) THEN
  330. *
  331. *        pour les materiaux endommageables de lemaitre traitement special
  332. *        car ils peuvent dependre de la temperature
  333. *
  334.           NTABO1 = 0
  335.           NTABO2 = 0
  336.           SEGINI WR10
  337.           DO 2200 JC=1,NMATT
  338.             IF (TYMAT(JC)(1:8).EQ.'REAL*8  ') THEN
  339.                          NTABO1=NTABO1+1
  340.                          NTABO2=NTABO2+1
  341.                          SEGADJ WR10
  342.                          IABLO1(NTABO1)=1
  343.                          TABLO2(NTABO2)=XMAT(JC)
  344.             ELSE IF (TYMAT(JC)(9:16).EQ.'EVOLUTIO') THEN
  345.                          CALL KSISIG(WRK0,JC,WRK2,NCOURB,KERRE)
  346.                          IF (KERRE.NE.0) GOTO 1990
  347.                          NTABO1=NTABO1+1
  348.                          NTABO=NTABO2
  349.                          NTABO2=NTABO2+(2*NCOURB)
  350.                          SEGADJ WR10
  351.                          IABLO1(NTABO1)=2*NCOURB
  352.                          DO 2050 JCC=1,NCOURB
  353.                                 TABLO2(NTABO+(2*JCC-1))=TRAC(2*JCC-1)
  354.                                 TABLO2(NTABO+(2*JCC))=TRAC(2*JCC)
  355. 2050                     continue
  356.             ELSE IF (TYMAT(JC)(9:16).EQ.'NUAGE   ') THEN
  357.                     NTABO3 = 0
  358.                     NTABO4 = 0
  359.                     SEGINI WR11
  360.                     CALL XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE)
  361.                     IF (KERRE.NE.0) THEN
  362.                                         SEGSUP WR10
  363.                                         SEGSUP WR11
  364.                                         KERR1=2
  365.                                         GOTO 1990
  366.                     ENDIF
  367. *                    segadj wr11
  368.                     NTABO=NTABO1
  369.                     NTABOO=NTABO2
  370.                     NTABO1=NTABO1+NTABO3+1
  371.                     NTABO2=NTABO2+NTABO4
  372.                     SEGADJ WR10
  373.                     IABLO1(NTABO+1)=NTABO3
  374.                     DO 2075 JCC=1,NTABO3
  375. 2075                       iablo1(ntabo+1+jcc)=iablo3(jcc)
  376.                     DO 2125 JCC=1,NTABO4
  377. 2125                       tablo2(ntaboo+jcc)=tablo4(jcc)
  378.                     SEGSUP WR11
  379.             ENDIF
  380. 2200      continue
  381.           ENDIF
  382. *
  383. * >>>>>>>>>>   fin du traitement du materiau
  384. *
  385. *        on recupere les caracteristiques geometriques
  386. *
  387.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  388.      .           WRK1)
  389. *      CALL DEFCAR(NCARR,ICARA,IB,IGAU,MFR,MELE,IVACAR,
  390. *     .           XCAR)
  391. *
  392. *
  393. *          quelques impressions si iimpi = 99
  394. *
  395. *      IF(IIMPI.EQ.99) THEN
  396. *         WRITE(IOIMP,66770) IB,IGAU
  397. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  398. *         WRITE(IOIMP,66771) MATE,INPLAS
  399. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  400. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  401. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  402. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  403. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  404. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  405. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  406. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  407. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  408. *         IF(IVACAR.NE.0)THEN
  409. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  410. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  411. *         ENDIF
  412. *      ENDIF
  413. *
  414. *   mise à disposition des temperatures tini tfin tref
  415. *   aux points de gauss
  416. *
  417.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  418.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  419.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  420.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  421.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  422.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  423.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  424.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  425.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  426.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  427.          ENDIF
  428. *
  429. *
  430. *---------------------------------------------------------------------
  431. *
  432. *                  ecoulement selon les modeles
  433. *
  434. *---------------------------------------------------------------------
  435. *
  436. *
  437. *     modeles de viscoplasticite integres par consti
  438. *
  439.            IF ( INPLAS .EQ. 29) THEN
  440. *
  441.                         NYOG=IABLO1(1)
  442.                         NYNU=IABLO1(2)
  443.                         NYALFA=IABLO1(3)
  444.                         NYSMAX=IABLO1(4)
  445.                         NYN=IABLO1(5)
  446.                         NYM=IABLO1(6)
  447.                         NYKK=IABLO1(7)
  448.                         NYALF1=IABLO1(8)
  449.                         NYBET1=IABLO1(9)
  450.                         NYR=IABLO1(10)
  451.                         NYA=IABLO1(11)
  452.                         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  453.      +                        AND.IFOUR.EQ.-2) THEN
  454.                           INTMAT=15
  455.                         ELSE
  456.                           INTMAT=14
  457.                         ENDIF
  458.                         IF (NTABO1.EQ.INTMAT) THEN
  459.                            NNKX=1
  460.                            NYKX=IABLO1(12)
  461.                         ELSE
  462.                            NNKX=IABLO1(12)
  463.                            NYKX=0
  464.                            DO 1881 I=1,NNKX
  465.  1881                      NYKX=NYKX+(2*IABLO1(12+I))
  466.                            NYKX=NYKX+NNKX
  467.                         ENDIF
  468.                         NYRHO=IABLO1(NTABO1)
  469.                         NSIGY=1
  470.                         SEGINI WRK9
  471.                         CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  472.                         SEGSUP WR10
  473.                         IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  474.                            NCOURB=2*NKX(1)
  475.                         ELSE
  476.                            NCOURB=NKX(1)
  477.                            DO 1882 I=1,NNKX
  478.  1882                            IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  479.                                  NCOURB=2*NCOURB
  480.                        ENDIF
  481.                        SEGINI WRK7
  482.                   IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN
  483.                         CALL ZDANUL(SIGF,NSTRS)
  484.                         DO 1883 I=1,NVARI
  485.                           VARF(I) = VAR0(I)
  486.  1883                   CONTINUE
  487.                         VARF(3) =  1.0
  488.                         DO 1884 I=1,NSTRS
  489.                           EPINF(I) = EPIN0(I)
  490.  1884                   CONTINUE
  491.                         SEGSUP WRK7
  492.                         SEGSUP WRK9
  493.                   ELSE
  494.              CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  495.      1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT,
  496.      2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN,
  497.      3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1,
  498.      5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  499.      6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  500. c
  501. c
  502.                   SEGSUP WRK7
  503.                   SEGSUP WRK9
  504.                   IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN
  505.                   INTERR(1)=IB
  506.                   INTERR(2)=IGAU
  507.                   REAERR(1)=TLIFE
  508.                   CALL ERREUR(-279)
  509.                   ENDIF
  510.                   DTOPTI  = MIN(DTOPTI,DTT)
  511.                   NINCMA = MAX(NINCMA,NSSINC)
  512.                   NCOMP = NCOMP + 1
  513.                   TSOM = TSOM + DTT
  514.                   NSOM = NSOM + NSSINC
  515.                   NINV = NINV + INV
  516.                   TCAR = TCAR + DTT* DTT
  517.                   IF(KERRE.NE.0) THEN
  518.                      KERR1=1
  519.                   END IF
  520.                   END IF
  521. c
  522. c        modele plastique d'endommagement de lemaitre
  523. c        ++++++++++++++++++++++++++++++++++++++++++++
  524. c  traitement du materiau qui depend eventuellement de la temperature
  525. c  ------------------------------------------------------------------
  526.             ELSE IF (INPLAS.EQ.26) THEN
  527.                         NYOG=IABLO1(1)
  528.                         NYNU=IABLO1(2)
  529.                         NYRHO=IABLO1(3)
  530.                         NYALFA=IABLO1(4)
  531.                         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  532.      +                        AND.IFOUR.EQ.-2) THEN
  533.                           INTMAT=10
  534.                         ELSE
  535.                           INTMAT=9
  536.                         ENDIF
  537.                         IF (NTABO1.EQ.INTMAT) THEN
  538.                            NNKX=1
  539.                            NYKX=IABLO1(5)
  540.                            IEPS=0
  541.                         ELSE
  542.                            NNKX=IABLO1(5)
  543.                            NYKX=0
  544.                            DO 1789 I=1,NNKX
  545.  1789                      NYKX=NYKX+(2*IABLO1(5+I))
  546.                            NYKX=NYKX+NNKX
  547.                            IEPS=1
  548.                         ENDIF
  549.                         IORIGI=6+(IEPS*NNKX)
  550.                         NYN=IABLO1(IORIGI)
  551.                         NYM=IABLO1(IORIGI+1)
  552.                         NYKK=IABLO1(IORIGI+2)
  553.                         NYSMAX=0
  554.                         NYALF1=0
  555.                         NYBET1=0
  556.                         NYR=0
  557.                         NYA=0
  558.                         NSIGY=0
  559.                         SEGINI WRK9
  560.                         CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  561.                         SEGSUP WR10
  562. c
  563. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  564. c *** on n' ecoule pas
  565. c
  566.                CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  567.                IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  568.                   DO 1115 IEN=1,NVARI
  569.                      VARF(IEN)=VAR0(IEN)
  570. 1115              continue
  571.                   VARF(3)=1.D0
  572.                   CALL ZDANUL(SIGF,NSTRS)
  573.                   CALL ZDANUL(DEFP,NSTRS)
  574.                   SEGSUP WRK9
  575.                ELSE
  576. c ----------------------------------------------------------------------
  577. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  578. c                     p est en supplement
  579. c ----------------------------------------------------------------------
  580.                   NNVARI=2
  581.                   IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  582.                     CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  583.                     NCOURB=2*NKX(1)
  584.                   ELSE
  585.                     NCOURB=NKX(1)
  586.                     DO 1119 I=1,NNKX
  587. 1119                  if (nkx(i).ge.ncourb) ncourb=nkx(i)
  588.                     NCOURB=4*NCOURB
  589.                   ENDIF
  590.                   IF (KERRE.EQ.0) THEN
  591.                     SEGINI WRK7
  592.       CALL ENDOM(WRK0,WR00,WRK1,WRK6,WRK7,WRK8,WRK9,WTRAV,NSTRSS,
  593.      1 NMATT,ICARA,INPLAS,NVARI,PRECIS,MFR1,IFOURB,KERRE,NNVARI,
  594.      2 NYOG,NYNU,NYRHO,NYALFA,NNKX,NYKX,NCOURB,NYN,NYM,NYKK,TETA1,
  595.      3       TETA2,TREFA,ITHHER,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  596.      4                  MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI)
  597.                     SEGSUP WRK7
  598.                     SEGSUP WRK9
  599.                     IF(KERRE.GT.200) THEN
  600.                        KERR1=1
  601.                     END IF
  602.                   END IF
  603.                END IF
  604.             ELSE
  605.                KERRE = 99
  606.             ENDIF
  607. *
  608. *   Erreurs
  609. *      - problèmes de convergence
  610. *
  611.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  612. *
  613. *      - autres problèmes
  614. *
  615.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  616.      .           KERR1,KERRE)
  617.  1998 IF (KERRE.GT.0) THEN
  618.          IF (LOGVIS) SEGSUP WRK8
  619.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  620.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  621.             SEGSUP WRK4
  622.          ENDIF
  623.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  624.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  625.      1     .OR.MFR.EQ.33)) THEN
  626.            SEGDES MINTE2
  627.            SEGSUP WRK22
  628.          ENDIF
  629.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  630.             SEGDES MELVA3
  631.             SEGDES MELVA4
  632.             SEGDES MELVA5
  633.             SEGDES MCHAM3
  634.             SEGDES MCHAM4
  635.             SEGDES MCHAM5
  636.          ENDIF
  637.          RETURN
  638.       ENDIF
  639. c
  640. c
  641. c     remplissage du segment contenant les contraintes a la fin
  642. *     ( rearrangement pour milieu poreux ),
  643. c     les variables internes finales
  644. c     et les increments de deformations plastiques
  645. c
  646.       CALL DEFSIG(MFR,NDEF,
  647.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  648.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  649.      .     CMATE,MATE,MELE,KERRER)
  650.       IF (KERRER.GT.0) GOTO 1000
  651. c
  652. c
  653. c    fin de la boucle sur les points de gauss
  654. c
  655. 1100     continue
  656. c
  657. c    special poutres et tuyaux  sauf timoschenko
  658. c
  659.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  660. c
  661. c     fin de la boucle sur les elements
  662. c
  663. 1000  continue
  664. c
  665. *  FIN: modèles visqueux, on stocke le pas de temps
  666. *  optimal en indice 'dtopti'
  667. *
  668.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  669.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  670.       IF (LOGVIS) SEGSUP WRK8
  671. *
  672. *
  673.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  674.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  675.          SEGSUP WRK4
  676.       END IF
  677.       IF(INPLAS.EQ.26) THEN
  678.         SEGSUP WRK6
  679.         SEGSUP WRK8
  680.       END IF
  681.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  682.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  683.      1     .OR.MFR.EQ.33)) THEN
  684.         SEGDES MINTE2
  685.         SEGSUP WRK22
  686.       ENDIF
  687. *
  688.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  689.             SEGDES MELVA3
  690.             SEGDES MELVA4
  691.             SEGDES MELVA5
  692.             SEGDES MCHAM3
  693.             SEGDES MCHAM4
  694.             SEGDES MCHAM5
  695.       ENDIF
  696. *
  697.       RETURN
  698.       END
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  
  721.  
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  

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