Télécharger la plaquette Cast3M


fr en

Télécharger ecou20.eso

Retour à la liste

Numérotation des lignes : 

ecou20

  1. C ECOU20    SOURCE    OF166741  25/11/04    21:15:46     12349          
  2.       SUBROUTINE ECOU20(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: - VISCOPLASTIQUES ET FLUAGE 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
  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 SMCHAML
  77. -INC SMELEME
  78. -INC SMCOORD
  79. -INC SMMODEL
  80. -INC SMINTE
  81. -INC CCHAMP
  82. -INC CECOU
  83. c=======================================================================
  84. c  la variable kerre regit les impressions d erreurs dans plast
  85. c      toutes erreurs de ecoule gerees dans ce sous programme
  86. c   kerre=0 tout ok
  87. c        de 1 a 6  s aligner sur valeurs donnees par ecoinc
  88. c     =   7  un element tuyau a une epaisseur nulle
  89. c     =  21  on ne trouve pas d intersection avec la surface de charge
  90. c     =  22  sig0 a l exterieur de la surface de charge
  91. c
  92. c             anomalies avec la courbe de traction
  93. c     =  30 limite elastique nulle
  94. c     =  31 trop de points
  95. c     =  32 pas assez de points
  96. c     =  33 pente incorrecte
  97. c     =  34 module d'young nul
  98. c     =  35 manque l'origine
  99. c     =  36 pente a l'origine non egale a e
  100. c     =  37 manque la courbe de traction
  101. c     =  38 nu devrait etre nul
  102. c
  103. c     =  48 donnees erronnees pour drucker-prager
  104. c     =  49 matrice singuliere dans iter internes drucker-prager
  105. c     =  51 pb dans drucker prager option non disponible
  106. c     =  52 pb dans drucker prager donnees incompatibles
  107. c     =  53 pb dans drucker prager solution impossible
  108. c     =  54 les valeurs admissibles pour istep sont 0 1 ou 2
  109. c     =  55 modele non implante en non local
  110. c     =  56 probleme dans l'integration du modele mazars
  111. c     =  57  ....
  112. c     =  58  ....
  113. c     =  59  ....
  114. c     =  60 pb donnees du cam-clay
  115. c
  116. c     =  99 cas non encore disponible
  117. c=======================================================================
  118. *
  119.       SEGMENT WRK0
  120.        REAL*8 XMAT(NCXMAT)
  121.       ENDSEGMENT
  122. *
  123.       SEGMENT WR00
  124.        CHARACTER*16 TYMAT(NCXMAT)
  125.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  126.       ENDSEGMENT
  127. *
  128.       SEGMENT WRK1
  129.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  130.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  131.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  132.       ENDSEGMENT
  133. *
  134.       SEGMENT WRK2
  135.         REAL*8 TRAC(LTRAC)
  136.       ENDSEGMENT
  137. *
  138.       SEGMENT WRK22
  139.       REAL*8 XXE(3,NBNN)
  140.       ENDSEGMENT
  141. *
  142.       SEGMENT WRK3
  143.         REAL*8 WORK(LW),WORK2(LW2)
  144.       ENDSEGMENT
  145. *
  146.       SEGMENT WRK4
  147.         REAL*8 XE(3,NBBB)
  148.       ENDSEGMENT
  149. *
  150.       SEGMENT WRK5
  151.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  152.       ENDSEGMENT
  153. *
  154.       SEGMENT WRK6
  155.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  156.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  157.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  158.       ENDSEGMENT
  159. *
  160.       SEGMENT WRK7
  161.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  162.       ENDSEGMENT
  163. *
  164.       SEGMENT WRK8
  165.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  166.       ENDSEGMENT
  167. *
  168.       SEGMENT WRK9
  169.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  170.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  171.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  172.         REAL*8 SIGY(NSIGY)
  173.         INTEGER NKX(NNKX)
  174.       ENDSEGMENT
  175. *
  176.       SEGMENT WR10
  177.         INTEGER IABLO1(NTABO1)
  178.         REAL*8  TABLO2(NTABO2)
  179.       ENDSEGMENT
  180. *
  181.       SEGMENT WR11
  182.         INTEGER IABLO3(NTABO3)
  183.         REAL*8  TABLO4(NTABO4)
  184.       ENDSEGMENT
  185. *
  186.       SEGMENT WTRAV
  187.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  188.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  189.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  190.         REAL*8 XLOC(3,3),XGLOB(3,3)
  191.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  192.       ENDSEGMENT
  193. *
  194.       SEGMENT WPOUT
  195.          REAL*8  X(2),Y(2),Z(2)
  196.       ENDSEGMENT
  197.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  198.       LOGICAL LUNI1,LUNI2
  199.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  200.  
  201.       CHARACTER*72 CHARRE
  202.       CHARACTER*8  CMATE
  203. *
  204. *   mise à disposition des temperatures tini tfin tref
  205. *   aux points de gauss
  206. *
  207.         TETA1=-1.E35
  208.          TETA2=-1.E35
  209.          TETREF=-1.E35
  210.          TREFA=-1.E35
  211.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  212.             MCHAM3=IPH1
  213.             MCHAM4=IPH2
  214.             MCHAM5=IPH3
  215.             SEGACT MCHAM3
  216.             SEGACT MCHAM4
  217.             SEGACT MCHAM5
  218.             MELVA3=MCHAM3.IELVAL(1)
  219.             MELVA4=MCHAM4.IELVAL(1)
  220.             MELVA5=MCHAM5.IELVAL(1)
  221.             SEGACT MELVA3
  222.             SEGACT MELVA4
  223.             SEGACT MELVA5
  224.          ENDIF
  225. c
  226. c   Initialisations de variables
  227. c---------------------------------
  228.       WRK8 = 0
  229.       WRK22 = 0
  230.       minte2 = 0
  231.       WRK4 = 0
  232. c      - mise à zéro des variables du commun NECOU si besoin
  233. c      - modèles viscoplastiques:
  234. c                  . on récupère le pas de temps
  235. c                  . on récupère le nombre maximal de sous-pas
  236. c                  . on met IND=1
  237. c      - initialisation des dimensions des tableaux des segments
  238. c   Sorties: en plus du commun NECOU, on range les autres données
  239. c   initialisées dans les COMMON IECOU et XECOU
  240. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  241. c   argument de DEFINI
  242. c
  243.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  244.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  245.      .           IPMAIL,IVAMAT,
  246.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  247.      .           LUNI1,LUNI2,LW,KERRE)
  248.       IF (KERRE.EQ.999) RETURN
  249.  
  250.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  251.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  252.      1     .OR.MFR.EQ.33)) THEN
  253.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  254.         MINTE2=IPTR1
  255.         SEGINI WRK22
  256.       ENDIF
  257.       IF (LOGVIS) SEGINI WRK8
  258.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  259.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  260.          SEGINI WRK4
  261.       ENDIF
  262.       SEGINI WTRAV
  263. *
  264. *       boucle sur les elements
  265. *
  266.       DO 1000 IB=1,NBELEM
  267. *
  268. *  Matériaux orthotropes, anisotropes et unidirectionnels
  269. *  en formulation massive:
  270. *     - on cherche  les coordonnees des noeuds de l element ib
  271. *     - calcul des axes locaux
  272. *  Cas particulier de l'ACIER_UNI
  273. *
  274.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  275.      .     MELEME,WRK4,WRK22,WTRAV)
  276. *
  277. *       boucle sur les points de gauss
  278. *
  279.          DO 1100 IGAU=1,NBPTEL
  280. *
  281. *  -recuperation de valmat et de valcar
  282. *  -on recupere les contraintes initiales
  283. *  -on recupere les variables internes
  284. *  -on recupere les deformations inelastiques initiales si besoin
  285. *  -on recupere les increments de deformations totales
  286. *  -on cherche la section de l'element ib
  287. *  -prise en compte de l'epaisseur et de l'excentrement
  288. *  dans le cas des coques minces avec ou sans cisaillement
  289. *  transverse
  290. *
  291.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  292.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  293.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  294.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  295. *
  296. *     on recupere les constantes du materiau
  297. *     calcul des contraintes effectives en milieu poreux
  298. *
  299.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  300.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  301.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  302.      .        BID,BID2,KERR0)
  303.       IF (KERR0.EQ.99) THEN
  304.          KERRE=99
  305.          GOTO 1000
  306.       ELSE IF (KERR0.EQ.10) THEN
  307.          GOTO 1000
  308.       ENDIF
  309. *
  310. * >>>>>>>>>>   fin du traitement du materiau
  311. *
  312. *        on recupere les caracteristiques geometriques
  313. *
  314.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  315.      .           WRK1)
  316. *
  317. *          quelques impressions si iimpi = 99
  318. *
  319. *      IF(IIMPI.EQ.99) THEN
  320. *         WRITE(IOIMP,66770) IB,IGAU
  321. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  322. *         WRITE(IOIMP,66771) MATE,INPLAS
  323. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  324. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  325. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  326. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  327. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  328. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  329. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  330. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  331. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  332. *         IF(IVACAR.NE.0)THEN
  333. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  334. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  335. *         ENDIF
  336. *      ENDIF
  337. *
  338. *   mise à disposition des temperatures tini tfin tref
  339. *   aux points de gauss
  340. *
  341.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  342.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  343.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  344.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  345.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  346.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  347.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  348.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  349.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  350.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  351.          ENDIF
  352. *
  353. *---------------------------------------------------------------------
  354. *
  355. *                  ecoulement selon les modeles
  356. *
  357. *---------------------------------------------------------------------
  358. *
  359. *     modeles de viscoplasticite integres par consti
  360. *
  361.             IF ( INPLAS .EQ. 17 .OR.
  362.      2                (INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  363.      4                INPLAS .EQ. 61 .OR.
  364.      4                INPLAS .EQ. 63 .OR.
  365.      1                INPLAS .EQ. 53 .OR. INPLAS .EQ. 102 .OR.
  366.      8                INPLAS .EQ. 44 .OR. INPLAS .EQ. 76  .OR.
  367.      9                INPLAS .EQ. 45 .OR. INPLAS .EQ. 77  .OR.
  368.      9                INPLAS .EQ. 84 .OR. INPLAS .EQ. 85  .OR.
  369.      9                INPLAS .EQ. 86 .OR. INPLAS .EQ. 70  ) THEN
  370. *
  371.                   IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN
  372.                         VAR0(NVARI)=XMAT(20)
  373.                   ENDIF
  374.                   IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN
  375.                         VAR0(NVARI-2)=XMAT(20)
  376.                         VAR0(NVARI-1)=XMAT(21)
  377.                         VAR0(NVARI)=XMAT(27)
  378.                   ENDIF
  379. *
  380.                   SEGINI WRK7
  381.                   SEGINI WRK9
  382.              CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  383.      1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT,
  384.      2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN,
  385.      3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1,
  386.      5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  387.      6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  388. c
  389. c
  390. c          write(6,*) istep
  391.           IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  392.           IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  393.           CALL ERREUR(KERREU1)
  394.           ENDIF
  395.           ENDIF
  396.                   SEGSUP WRK7
  397.                   SEGSUP WRK9
  398.                   DTOPTI  = MIN(DTOPTI,DTT)
  399.                   NINCMA = MAX(NINCMA,NSSINC)
  400.                   NCOMP = NCOMP + 1
  401.                   TSOM = TSOM + DTT
  402.                   NSOM = NSOM + NSSINC
  403.                   NINV = NINV + INV
  404.                   TCAR = TCAR + DTT* DTT
  405.                   IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  406.                      KERR1=1
  407.                   END IF
  408. c
  409.             ELSE
  410.                KERRE = 99
  411.             ENDIF
  412. *
  413. *   Erreurs
  414. *      - problèmes de convergence
  415. *
  416.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  417. *
  418. *      - autres problèmes
  419. *
  420.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,KERR1,KERRE)
  421.       IF (KERRE.NE.0) GOTO 99
  422. c
  423. c     remplissage du segment contenant les contraintes a la fin
  424. *     ( rearrangement pour milieu poreux ),
  425. c     les variables internes finales
  426. c     et les increments de deformations plastiques
  427. c
  428.       CALL DEFSIG(MFR,NDEF,
  429.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  430.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  431.      .     CMATE,MATE,MELE,KERRER)
  432.       IF (KERRER.NE.0) GOTO 1000
  433. c
  434. c    fin de la boucle sur les points de gauss
  435. c
  436. 1100     continue
  437. c
  438. c    special poutres et tuyaux  sauf timoschenko
  439. c
  440.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  441. c
  442. c     fin de la boucle sur les elements
  443. c
  444. 1000  continue
  445. c
  446. *  FIN: modèles visqueux, on stocke le pas de temps
  447. *  optimal en indice 'dtopti'
  448. *
  449.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  450.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  451. *
  452.  
  453.  99   CONTINUE
  454.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  455.       IF (LOGVIS) SEGSUP WRK8
  456.       IF (WRK4.NE.0) SEGSUP WRK4
  457.       IF (WRK22.NE.0) THEN
  458.         SEGDES MINTE2
  459.         SEGSUP WRK22
  460.       ENDIF
  461.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  462.         SEGDES MELVA3,MELVA4,MELVA5
  463.         SEGDES MCHAM3,MCHAM4,MCHAM5
  464.       ENDIF
  465.  
  466.       RETURN
  467.       END
  468.  
  469.  
  470.  

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