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    CB215821  24/04/12    21:15:40     11897          
  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.  
  76. -INC PPARAM
  77. -INC CCOPTIO
  78. -INC SMCHAML
  79. -INC SMELEME
  80. -INC SMCOORD
  81. -INC SMMODEL
  82. -INC SMINTE
  83. -INC CCHAMP
  84. -INC CECOU
  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 MPTVAL
  122.         INTEGER IPOS(NS)    ,NSOF(NS)
  123.         INTEGER      IVAL(NCOSOU)
  124.         CHARACTER*16 TYVAL(NCOSOU)
  125.       ENDSEGMENT
  126. *
  127.       SEGMENT WRK0
  128.        REAL*8 XMAT(NCXMAT)
  129.       ENDSEGMENT
  130. *
  131.       SEGMENT WR00
  132.        CHARACTER*16 TYMAT(NCXMAT)
  133.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  134.       ENDSEGMENT
  135. *
  136.       SEGMENT WRK1
  137.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  138.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  139.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  140.       ENDSEGMENT
  141. *
  142.       SEGMENT WRK2
  143.         REAL*8 TRAC(LTRAC)
  144.       ENDSEGMENT
  145. *
  146.       SEGMENT WRK22
  147.       REAL*8 XXE(3,NBNN)
  148.       ENDSEGMENT
  149. *
  150.       SEGMENT WRK3
  151.         REAL*8 WORK(LW),WORK2(LW2)
  152.       ENDSEGMENT
  153. *
  154.       SEGMENT WRK4
  155.         REAL*8 XE(3,NBNN)
  156.       ENDSEGMENT
  157. *
  158.       SEGMENT WRK5
  159.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  160.       ENDSEGMENT
  161. *
  162.       SEGMENT WRK6
  163.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  164.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  165.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  166.       ENDSEGMENT
  167. *
  168.       SEGMENT WRK7
  169.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  170.       ENDSEGMENT
  171. *
  172.       SEGMENT WRK8
  173.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  174.       ENDSEGMENT
  175. *
  176.       SEGMENT WRK9
  177.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  178.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  179.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  180.         REAL*8 SIGY(NSIGY)
  181.         INTEGER NKX(NNKX)
  182.       ENDSEGMENT
  183. *
  184.       SEGMENT WR10
  185.         INTEGER IABLO1(NTABO1)
  186.         REAL*8  TABLO2(NTABO2)
  187.       ENDSEGMENT
  188. *
  189.       SEGMENT WR11
  190.         INTEGER IABLO3(NTABO3)
  191.         REAL*8  TABLO4(NTABO4)
  192.       ENDSEGMENT
  193. *
  194.       SEGMENT WTRAV
  195.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  196.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  197.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  198.         REAL*8 XLOC(3,3),XGLOB(3,3)
  199.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  200.       ENDSEGMENT
  201. *
  202.       SEGMENT WPOUT
  203.          REAL*8  X(2),Y(2),Z(2)
  204.       ENDSEGMENT
  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. c
  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
  236. c   Initialisations de variables
  237. c---------------------------------
  238. c      - mise à zéro des variables du commun NECOU si besoin
  239. c      - modèles viscoplastiques:
  240. c                  . on récupère le pas de temps
  241. c                  . on récupère le nombre maximal de sous-pas
  242. c                  . on met IND=1
  243. c      - initialisation des dimensions des tableaux des segments
  244. c   Sorties: en plus du commun NECOU, on range les autres données
  245. c   initialisées dans les COMMON IECOU et XECOU
  246. c   Sauf pour KERRE,LOGVIS,LW,LUNI1 et LUNI2 qui sont sortis comme
  247. c   argument de DEFINI
  248. c
  249.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  250.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  251.      .           IPMAIL,IVAMAT,
  252.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  253.      .           LUNI1,LUNI2,LW,KERRE)
  254.       IF (KERRE.EQ.999) RETURN
  255.  
  256. c
  257. c  Initialisations des segments de travail
  258. c
  259.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  260.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  261.      1     .OR.MFR.EQ.33)) THEN
  262.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  263.         MINTE2=IPTR1
  264.         SEGACT MINTE2
  265.         SEGINI WRK22
  266.       ENDIF
  267. c
  268.       IF (LOGVIS) SEGINI WRK8
  269.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  270.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  271.          SEGINI WRK4
  272.       ENDIF
  273. c
  274.       SEGINI WTRAV
  275. *
  276. *
  277. *       boucle sur les elements
  278. *
  279.       DO 1000 IB=1,NBELEM
  280. *
  281. *  Matériaux orthotropes, anisotropes et unidirectionnels
  282. *  en formulation massive:
  283. *     - on cherche  les coordonnees des noeuds de l element ib
  284. *     - calcul des axes locaux
  285. *  Cas particulier de l'ACIER_UNI
  286. *
  287.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  288.      .     MELEME,WRK4,WRK22,WTRAV)
  289. *
  290. *       boucle sur les points de gauss
  291. *
  292.          DO 1100 IGAU=1,NBPTEL
  293. *
  294. *  -recuperation de valmat et de valcar
  295. *  -on recupere les contraintes initiales
  296. *  -on recupere les variables internes
  297. *  -on recupere les deformations inelastiques initiales si besoin
  298. *  -on recupere les increments de deformations totales
  299. *  -on cherche la section de l'element ib
  300. *  -prise en compte de l'epaisseur et de l'excentrement
  301. *  dans le cas des coques minces avec ou sans cisaillement
  302. *  transverse
  303. *
  304.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  305.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  306.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  307.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  308. *
  309. *     on recupere les constantes du materiau
  310. *     calcul des contraintes effectives en milieu poreux
  311. *
  312.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  313.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  314.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  315.      .        BID,BID2,KERR0)
  316.       IF (KERR0.EQ.99) THEN
  317.          KERRE=99
  318.          GOTO 1000
  319.       ELSE IF (KERR0.EQ.10) THEN
  320.          GOTO 1000
  321.       ENDIF
  322. *
  323. * >>>>>>>>>>   fin du traitement du materiau
  324. *
  325. *        on recupere les caracteristiques geometriques
  326. *
  327.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  328.      .           WRK1)
  329. *
  330. *          quelques impressions si iimpi = 99
  331. *
  332.        IF(IIMPI.EQ.99) THEN
  333.          WRITE(IOIMP,66770) IB,IGAU
  334. 66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  335.          WRITE(IOIMP,66771) MATE,INPLAS
  336. 66771    format('0  mate=',i4,2x,'inplas=',i4/)
  337.          WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  338. 66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  339.          WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  340. 66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  341.          WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  342. 66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  343.          WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  344. 66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  345.          IF(IVACAR.NE.0)THEN
  346.             WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  347. 66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  348.          ENDIF
  349.        ENDIF
  350. *
  351. *   mise à disposition des temperatures tini tfin tref
  352. *   aux points de gauss
  353. *
  354.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  355.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  356.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  357.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  358.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  359.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  360.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  361.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  362.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  363.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  364.          ENDIF
  365. *
  366. *
  367. *---------------------------------------------------------------------
  368. *
  369. *                  ecoulement selon les modeles
  370. *
  371. *---------------------------------------------------------------------
  372. *
  373.             IF(INPLAS.EQ.0)THEN
  374. c
  375. c      modele elastique lineaire
  376. c
  377.          CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,
  378.      1    N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,
  379.      2      NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  380.      3                            ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  381.               IF(IRTD.EQ.1) THEN
  382.                DO 1111 IC=1,NSTRSS
  383.                   IF(IND.EQ.1)THEN
  384.                      EPINF(IC)=0.D0
  385.                   ELSE
  386.                     DEFP(IC)=0.D0
  387.                   ENDIF
  388.                   SIGF(IC)=SIG0(IC)+DSIGT(IC)
  389. 1111           continue
  390.                DO 1112 IC=1,NVARI
  391.                   VARF(IC)=VAR0(IC)
  392. 1112           continue
  393.               ELSE
  394.                 KERRE=69
  395.                 GOTO 1990
  396.               ENDIF
  397. c
  398. c     modeles implantes dans ecoinc
  399. c
  400.             ELSE IF ( INPLAS .EQ. 1  .OR.
  401.      1                INPLAS .EQ. 3  .OR.
  402.      2                INPLAS .EQ. 4  .OR.
  403.      3                INPLAS .EQ. 5  .OR.
  404.      4                INPLAS .EQ. 7  .OR.
  405.      5                INPLAS .EQ. 12 .OR.
  406.      6                INPLAS .EQ. 15. OR. INPLAS.EQ.87 ) THEN
  407. c
  408. c     modele von mises isotrope associe ( d'apres inca )
  409. c
  410.                IF (INPLAS .EQ. 1) THEN
  411. c
  412. c    cas de la plasticite parfaite
  413. c
  414.                   NCOURB=2
  415.                   IF (MATE.EQ.4.AND.MFR.EQ.1.AND.IDIM.EQ.3) THEN
  416.                      TRAC(1)=XMAT(9)
  417.                      TRAC(3)=XMAT(9)
  418.                   ELSE
  419.                      TRAC(1)=XMAT(5)
  420.                      TRAC(3)=XMAT(5)
  421.                   ENDIF
  422.                   TRAC(2)=0.D0
  423.                   TRAC(4)=1.D9
  424.                   IF((IDIM.EQ.2.AND.XMAT(5).EQ.0.D0).OR.
  425.      +               (MATE.EQ.4.AND.MFR.EQ.1.AND.IDIM.EQ.
  426.      +                3.AND.XMAT(9).EQ.0.D0)) THEN
  427.                      KERRE = 33
  428.                   ELSE
  429.                      KERRE = 0
  430.                   ENDIF
  431. c
  432.                ELSE IF (INPLAS .EQ. 3) THEN
  433. c
  434. c    cas du modele de drucker-prager parfait
  435. c    les donnees sont les limites en traction et en compression
  436. c
  437.                   IMAPLA=5
  438.                   DEN =  ABS(XMAT(6)) + XMAT(5)
  439.                   IF(DEN.EQ.0.D0) THEN
  440.                      KERRE=48
  441.                   ELSE
  442.                      XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  443.                      XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  444.                      XMAT(6) = 1.D0
  445.                      XMAT(8)=XMAT(5)
  446.                      XMAT(9)=XMAT(6)
  447.                      XMAT(10)=XMAT(5)
  448.                      XMAT(11)=XMAT(6)
  449.                      XMAT(12)=XMAT(7)
  450.                      XMAT(13)=0.D0
  451. c
  452. c          petits tests sur les donnees
  453.                      IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  454.      &                   XMAT(5)*1.01/(XMAT(6)+1.D-20)
  455.      &                  .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  456.                         KERRE = 48
  457.                      ELSE
  458.                         KERRE = 0
  459.                      ENDIF
  460.                   END IF
  461.                ELSE IF (INPLAS .EQ. 4) THEN
  462. c
  463. c    cas de la plasticite cinematique bilineaire
  464. c
  465.                   IF(XMAT(5).EQ.0.D0) THEN
  466.                      KERRE=33
  467.                   ELSE
  468.                      ICINE=1
  469.                      NCOURB=2
  470.                      TRAC(1)=XMAT(5)
  471.                      TRAC(2)=0.D0
  472.                      TRAC(4)=1.D9
  473.                      TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4)
  474.                   END IF
  475.                ELSE IF (INPLAS .EQ.  5 .OR.INPLAS.EQ.87) THEN
  476. c
  477. c   cas de la plasticite isotrope ecrouissable
  478. c
  479. c  on recupere la courbe de traction
  480. c
  481.                   CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  482.                ELSE IF (INPLAS .EQ.  7 ) THEN
  483. c
  484. c    cas du modele chaboche
  485. c
  486.                   KERRE = 0
  487.                   ICINE = 1
  488.                   IMAPLA= 4
  489. c
  490.                ELSE IF (INPLAS .EQ.  12) THEN
  491. c
  492. c    cas du modele chaboche
  493. c
  494.                   KERRE = 0
  495.                   ICINE = 1
  496.                   IMAPLA= 4
  497.                ELSE IF (INPLAS .EQ. 15 ) THEN
  498. c
  499. c    cas du modele de drucker-prager general
  500. c
  501.                   IMAPLA=5
  502. c
  503. c          petits tests sur les donnees
  504. c
  505.                   IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  506.      1                 XMAT(5)*1.01/(XMAT(6)+1.D-20)
  507.      2                .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  508.                      KERRE = 48
  509.                   ELSE
  510.                      KERRE = 0
  511. c
  512. c          permutations pour ecoinc
  513. c
  514.                      DO 1113 I=5,7
  515.                         WW=XMAT(I)
  516.                         XMAT(I)=XMAT(I+5)
  517.                         XMAT(I+5)=WW
  518. 1113                 continue
  519.                   END IF
  520. c
  521.                END IF
  522.                IF (KERRE .EQ. 0) THEN
  523.                   DO 1114 IC=1,ICARA
  524.                      WORK(IC)=XCAR(IC)
  525. 1114              continue
  526.                   BID(1)=0.D00
  527.                   BID(2)=0.D00
  528.                   BID(3)=0.D00
  529.  
  530.                   IF ((INPLAS .EQ. 1  .OR.
  531.      &                 INPLAS .EQ. 4  .OR.
  532.      &                 INPLAS .EQ. 5  .OR.
  533.      &                 INPLAS .EQ. 7  .OR.
  534.      &                 INPLAS .EQ. 12.OR.INPLAS.EQ.87 ) .AND.
  535.      &                (MFR .EQ. 1 .OR.
  536.      &                 MFR .EQ. 3 .OR.
  537.      &                 MFR .EQ. 5 .OR.
  538.      &                 MFR .EQ. 7 .OR.
  539.      &                 MFR .EQ. 9 )     .AND.
  540.      &                (CMATE.NE.'UNIDIREC')) THEN
  541.  
  542.                   CALL ECOIN0(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  543.      &                  N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  544.      &            SIGF,VARF,DEFP,KERRE,MFR1,IB,IGAU,NSTRSS,EPAIST,MELE,
  545.      &                   NPINT,NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
  546.      &     XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS,NCOURB,IFOURB)
  547.  
  548.                   ELSE
  549.  
  550.                   mfr=mfr1
  551.                   CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  552.      1                  N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  553.      2            SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  554.      3                   NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  555.      4                    XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS)
  556.  
  557.                   ENDIF
  558.  
  559.  
  560.                END IF
  561. c
  562.             ELSE
  563.                KERRE = 99
  564.             ENDIF
  565. *
  566. *   Erreurs
  567. *      - problèmes de convergence
  568. *
  569.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  570. *
  571. *      - autres problèmes
  572. *
  573.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  574.      .           KERR1,KERRE)
  575.  1998 IF (KERRE.NE.0) THEN
  576.          IF (LOGVIS) SEGSUP WRK8
  577.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  578.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  579.             SEGSUP WRK4
  580.          ENDIF
  581.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  582.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  583.      1     .OR.MFR.EQ.33)) THEN
  584.            SEGDES MINTE2
  585.            SEGSUP WRK22
  586.          ENDIF
  587.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  588.             SEGDES MELVA3
  589.             SEGDES MELVA4
  590.             SEGDES MELVA5
  591.             SEGDES MCHAM3
  592.             SEGDES MCHAM4
  593.             SEGDES MCHAM5
  594.          ENDIF
  595.          RETURN
  596.       ENDIF
  597. c
  598. c     remplissage du segment contenant les contraintes a la fin
  599. *     ( rearrangement pour milieu poreux ),
  600. c     les variables internes finales
  601. c     et les increments de deformations plastiques
  602. c
  603.       CALL DEFSIG(MFR,NDEF,
  604.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  605.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  606.      .     CMATE,MATE,MELE,KERRER)
  607.       IF (KERRER.NE.0) GOTO 1000
  608. c
  609. c    fin de la boucle sur les points de gauss
  610. c
  611. 1100     continue
  612. c
  613. c    special poutres et tuyaux  sauf timoschenko
  614. c
  615.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  616. c
  617. c     fin de la boucle sur les elements
  618. c
  619. 1000  continue
  620. *
  621. *  FIN: modèles visqueux, on stocke le pas de temps
  622. *  optimal en indice 'dtopti'
  623. *
  624.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  625.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  626.       IF (LOGVIS) SEGSUP WRK8
  627. *
  628.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  629.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  630.          SEGSUP WRK4
  631.       END IF
  632.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  633.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  634.      1     .OR.MFR.EQ.33)) THEN
  635.         SEGDES MINTE2
  636.         SEGSUP WRK22
  637.       ENDIF
  638. *
  639.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  640.             SEGDES MELVA3
  641.             SEGDES MELVA4
  642.             SEGDES MELVA5
  643.             SEGDES MCHAM3
  644.             SEGDES MCHAM4
  645.             SEGDES MCHAM5
  646.       ENDIF
  647. *
  648.       RETURN
  649.       END
  650.  
  651.  
  652.  
  653.  
  654.  
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  
  670.  
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  
  680.  
  681.  
  682.  

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