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    OF166741  25/11/04    21:15:49     12349          
  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. -INC PPARAM
  75. -INC CCOPTIO
  76. -INC CCHAMP
  77. -INC CECOU
  78.  
  79. -INC SMCHAML
  80. -INC SMELEME
  81. -INC SMCOORD
  82. -INC SMMODEL
  83. -INC SMINTE
  84.  
  85. c=======================================================================
  86. c  la variable kerre regit les impressions d erreurs dans plast
  87. c      toutes erreurs de ecoule gerees dans ce sous programme
  88. c   kerre=0 tout ok
  89. c        de 1 a 6  s aligner sur valeurs donnees par ecoinc
  90. c     =   7  un element tuyau a une epaisseur nulle
  91. c     =  21  on ne trouve pas d intersection avec la surface de charge
  92. c     =  22  sig0 a l exterieur de la surface de charge
  93. c
  94. c             anomalies avec la courbe de traction
  95. c     =  30 limite elastique nulle
  96. c     =  31 trop de points
  97. c     =  32 pas assez de points
  98. c     =  33 pente incorrecte
  99. c     =  34 module d'young nul
  100. c     =  35 manque l'origine
  101. c     =  36 pente a l'origine non egale a e
  102. c     =  37 manque la courbe de traction
  103. c     =  38 nu devrait etre nul
  104. c
  105. c     =  48 donnees erronnees pour drucker-prager
  106. c     =  49 matrice singuliere dans iter internes drucker-prager
  107. c     =  51 pb dans drucker prager option non disponible
  108. c     =  52 pb dans drucker prager donnees incompatibles
  109. c     =  53 pb dans drucker prager solution impossible
  110. c     =  54 les valeurs admissibles pour istep sont 0 1 ou 2
  111. c     =  55 modele non implante en non local
  112. c     =  56 probleme dans l'integration du modele mazars
  113. c     =  57  ....
  114. c     =  58  ....
  115. c     =  59  ....
  116. c     =  60 pb donnees du cam-clay
  117. c
  118. c     =  99 cas non encore disponible
  119. c=======================================================================
  120. *
  121.       SEGMENT WRK0
  122.        REAL*8 XMAT(NCXMAT)
  123.       ENDSEGMENT
  124. *
  125.       SEGMENT WR00
  126.        CHARACTER*16 TYMAT(NCXMAT)
  127.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  128.       ENDSEGMENT
  129. *
  130.       SEGMENT WRK1
  131.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  132.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  133.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  134.       ENDSEGMENT
  135. *
  136.       SEGMENT WRK2
  137.         REAL*8 TRAC(LTRAC)
  138.       ENDSEGMENT
  139. *
  140.       SEGMENT WRK22
  141.       REAL*8 XXE(3,NBNN)
  142.       ENDSEGMENT
  143. *
  144.       SEGMENT WRK3
  145.         REAL*8 WORK(LW),WORK2(LW2)
  146.       ENDSEGMENT
  147. *
  148.       SEGMENT WRK4
  149.         REAL*8 XE(3,NBBB)
  150.       ENDSEGMENT
  151. *
  152.       SEGMENT WRK5
  153.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  154.       ENDSEGMENT
  155. *
  156.       SEGMENT WRK6
  157.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  158.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  159.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS)
  160.       ENDSEGMENT
  161. *
  162.       SEGMENT WRK7
  163.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  164.       ENDSEGMENT
  165. *
  166.       SEGMENT WRK8
  167.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  168.       ENDSEGMENT
  169. *
  170.       SEGMENT WRK9
  171.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  172.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  173.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  174.         REAL*8 SIGY(NSIGY)
  175.         INTEGER NKX(NNKX)
  176.       ENDSEGMENT
  177. *
  178.       SEGMENT WR10
  179.         INTEGER IABLO1(NTABO1)
  180.         REAL*8  TABLO2(NTABO2)
  181.       ENDSEGMENT
  182. *
  183.       SEGMENT WR11
  184.         INTEGER IABLO3(NTABO3)
  185.         REAL*8  TABLO4(NTABO4)
  186.       ENDSEGMENT
  187. *
  188.       SEGMENT WTRAV
  189.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  190.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  191.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  192.         REAL*8 XLOC(3,3),XGLOB(3,3)
  193.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  194.       ENDSEGMENT
  195. *
  196.       SEGMENT WPOUT
  197.          REAL*8  X(2),Y(2),Z(2)
  198.       ENDSEGMENT
  199. *
  200.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  201.       LOGICAL LUNI1,LUNI2
  202.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  203. *
  204.       CHARACTER*72 CHARRE
  205.       CHARACTER*8  CMATE
  206. *
  207. *   mise à disposition des temperatures tini tfin tref
  208. *   aux points de gauss
  209. *
  210.          TETA1=-1.E35
  211.          TETA2=-1.E35
  212.          TETREF=-1.E35
  213.          TREFA=-1.E35
  214.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  215.             MCHAM3=IPH1
  216.             MCHAM4=IPH2
  217.             MCHAM5=IPH3
  218.             SEGACT MCHAM3
  219.             SEGACT MCHAM4
  220.             SEGACT MCHAM5
  221.             MELVA3=MCHAM3.IELVAL(1)
  222.             MELVA4=MCHAM4.IELVAL(1)
  223.             MELVA5=MCHAM5.IELVAL(1)
  224.             SEGACT MELVA3
  225.             SEGACT MELVA4
  226.             SEGACT MELVA5
  227.          ENDIF
  228. c
  229. c   Initialisations de variables
  230. c---------------------------------
  231. c      - mise à zéro des variables du commun NECOU si besoin
  232. c      - modèles viscoplastiques:
  233. c                  . on récupère le pas de temps
  234. c                  . on récupère le nombre maximal de sous-pas
  235. c                  . on met IND=1
  236. c      - initialisation des dimensions des tableaux des segments
  237. c   Sorties: en plus du commun NECOU, on range les autres données
  238. c   initialisées dans les COMMON IECOU et XECOU
  239. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  240. c   argument de DEFINI
  241. c
  242.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  243.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  244.      .           IPMAIL,IVAMAT,
  245.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  246.      .           LUNI1,LUNI2,LW,KERRE)
  247.       IF (KERRE.EQ.999) RETURN
  248. c
  249. c  Initialisations des segments de travail
  250. c
  251.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  252.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  253.      1     .OR.MFR.EQ.33)) THEN
  254.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  255.         MINTE2=IPTR1
  256.         SEGACT MINTE2
  257.         SEGINI WRK22
  258.       ENDIF
  259. c
  260.       IF (LOGVIS) SEGINI WRK8
  261. *
  262. *    initialisation des segments de travail
  263. *
  264.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  265.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  266.          SEGINI WRK4
  267.       ENDIF
  268.       IF(INPLAS.EQ.26)THEN
  269.         SEGINI WRK6
  270.       ENDIF
  271. c
  272.       SEGINI WTRAV
  273. *
  274. *       boucle sur les elements
  275. *
  276.       DO 1000 IB=1,NBELEM
  277. *
  278. *  Matériaux orthotropes, anisotropes et unidirectionnels
  279. *  en formulation massive:
  280. *     - on cherche  les coordonnees des noeuds de l element ib
  281. *     - calcul des axes locaux
  282. *  Cas particulier de l'ACIER_UNI
  283. *
  284.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  285.      .     MELEME,WRK4,WRK22,WTRAV)
  286. *
  287. *       boucle sur les points de gauss
  288. *
  289.          DO 1100 IGAU=1,NBPTEL
  290. *
  291. *  -recuperation de valmat et de valcar
  292. *  -on recupere les contraintes initiales
  293. *  -on recupere les variables internes
  294. *  -on recupere les deformations inelastiques initiales si besoin
  295. *  -on recupere les increments de deformations totales
  296. *  -on cherche la section de l'element ib
  297. *  -prise en compte de l'epaisseur et de l'excentrement
  298. *  dans le cas des coques minces avec ou sans cisaillement
  299. *  transverse
  300. *
  301.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  302.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  303.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  304.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  305. *
  306. *     on recupere les constantes du materiau
  307. *     calcul des contraintes effectives en milieu poreux
  308. *
  309.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  310.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  311.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  312.      .        BID,BID2,KERR0)
  313.       IF (KERR0.EQ.99) THEN
  314.          KERRE=99
  315.          GOTO 1000
  316.       ELSE IF (KERR0.EQ.10) THEN
  317.          GOTO 1000
  318.       ENDIF
  319. *
  320.           IF ((INPLAS.EQ.29.).OR.(INPLAS.EQ.26)) THEN
  321. *
  322. *        pour les materiaux endommageables de lemaitre traitement special
  323. *        car ils peuvent dependre de la temperature
  324. *
  325.           NTABO1 = 0
  326.           NTABO2 = 0
  327.           SEGINI WR10
  328.           DO 2200 JC=1,NMATT
  329.             IF (TYMAT(JC)(1:8).EQ.'REAL*8  ') THEN
  330.                          NTABO1=NTABO1+1
  331.                          NTABO2=NTABO2+1
  332.                          SEGADJ WR10
  333.                          IABLO1(NTABO1)=1
  334.                          TABLO2(NTABO2)=XMAT(JC)
  335.             ELSE IF (TYMAT(JC)(9:16).EQ.'EVOLUTIO') THEN
  336.                          CALL KSISIG(WRK0,JC,WRK2,NCOURB,KERRE)
  337.                          IF (KERRE.NE.0) GOTO 1990
  338.                          NTABO1=NTABO1+1
  339.                          NTABO=NTABO2
  340.                          NTABO2=NTABO2+(2*NCOURB)
  341.                          SEGADJ WR10
  342.                          IABLO1(NTABO1)=2*NCOURB
  343.                          DO 2050 JCC=1,NCOURB
  344.                                 TABLO2(NTABO+(2*JCC-1))=TRAC(2*JCC-1)
  345.                                 TABLO2(NTABO+(2*JCC))=TRAC(2*JCC)
  346. 2050                     continue
  347.             ELSE IF (TYMAT(JC)(9:16).EQ.'NUAGE   ') THEN
  348.                     NTABO3 = 0
  349.                     NTABO4 = 0
  350.                     SEGINI WR11
  351.                     CALL XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE)
  352.                     IF (KERRE.NE.0) THEN
  353.                       SEGSUP WR10,WR11
  354.                       KERR1=2
  355.                       GOTO 1990
  356.                     ENDIF
  357.                     NTABO=NTABO1
  358.                     NTABOO=NTABO2
  359.                     NTABO1=NTABO1+NTABO3+1
  360.                     NTABO2=NTABO2+NTABO4
  361.                     SEGADJ WR10
  362.                     IABLO1(NTABO+1)=NTABO3
  363.                     DO JCC=1,NTABO3
  364.                        iablo1(ntabo+1+jcc)=iablo3(jcc)
  365.                     ENDDO
  366.                     DO JCC=1,NTABO4
  367.                        tablo2(ntaboo+jcc)=tablo4(jcc)
  368.                     ENDDO
  369.                     SEGSUP WR11
  370.             ENDIF
  371. 2200      continue
  372.           ENDIF
  373. *
  374. * >>>>>>>>>>   fin du traitement du materiau
  375. *
  376. *        on recupere les caracteristiques geometriques
  377. *
  378.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  379.      .           WRK1)
  380. *      CALL DEFCAR(NCARR,ICARA,IB,IGAU,MFR,MELE,IVACAR,
  381. *     .           XCAR)
  382. *
  383. *          quelques impressions si iimpi = 99
  384. *
  385. *      IF(IIMPI.EQ.99) THEN
  386. *         WRITE(IOIMP,66770) IB,IGAU
  387. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  388. *         WRITE(IOIMP,66771) MATE,INPLAS
  389. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  390. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  391. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  392. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  393. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  394. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  395. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  396. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  397. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  398. *         IF(IVACAR.NE.0)THEN
  399. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  400. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  401. *         ENDIF
  402. *      ENDIF
  403. *
  404. *   mise à disposition des temperatures tini tfin tref
  405. *   aux points de gauss
  406. *
  407.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  408.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  409.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  410.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  411.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  412.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  413.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  414.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  415.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  416.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  417.          ENDIF
  418. *
  419. *---------------------------------------------------------------------
  420. *
  421. *                  ecoulement selon les modeles
  422. *
  423. *---------------------------------------------------------------------
  424. *
  425. *     modeles de viscoplasticite integres par consti
  426. *
  427.            IF ( INPLAS .EQ. 29) THEN
  428. *
  429.                         NYOG=IABLO1(1)
  430.                         NYNU=IABLO1(2)
  431.                         NYALFA=IABLO1(3)
  432.                         NYSMAX=IABLO1(4)
  433.                         NYN=IABLO1(5)
  434.                         NYM=IABLO1(6)
  435.                         NYKK=IABLO1(7)
  436.                         NYALF1=IABLO1(8)
  437.                         NYBET1=IABLO1(9)
  438.                         NYR=IABLO1(10)
  439.                         NYA=IABLO1(11)
  440.                         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  441.      +                        AND.IFOUR.EQ.-2) THEN
  442.                           INTMAT=15
  443.                         ELSE
  444.                           INTMAT=14
  445.                         ENDIF
  446.                         IF (NTABO1.EQ.INTMAT) THEN
  447.                            NNKX=1
  448.                            NYKX=IABLO1(12)
  449.                         ELSE
  450.                            NNKX=IABLO1(12)
  451.                            NYKX=0
  452.                            DO I=1,NNKX
  453.                              NYKX=NYKX+(2*IABLO1(12+I))
  454.                            ENDDO
  455.                            NYKX=NYKX+NNKX
  456.                         ENDIF
  457.                         NYRHO=IABLO1(NTABO1)
  458.                         NSIGY=1
  459.                         SEGINI WRK9
  460.                         CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  461.                         SEGSUP WR10
  462.                         IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  463.                            NCOURB=2*NKX(1)
  464.                         ELSE
  465.                            NCOURB=NKX(1)
  466.                            DO I=1,NNKX
  467.                              IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  468.                            ENDDO
  469.                            NCOURB=2*NCOURB
  470.                        ENDIF
  471.                        SEGINI WRK7
  472.                   IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN
  473.                         CALL ZDANUL(SIGF,NSTRS)
  474.                         DO 1883 I=1,NVARI
  475.                           VARF(I) = VAR0(I)
  476.  1883                   CONTINUE
  477.                         VARF(3) =  1.0
  478.                         DO 1884 I=1,NSTRS
  479.                           EPINF(I) = EPIN0(I)
  480.  1884                   CONTINUE
  481.                         SEGSUP WRK7
  482.                         SEGSUP WRK9
  483.                   ELSE
  484.              CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  485.      1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT,
  486.      2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN,
  487.      3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1,
  488.      5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  489.      6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  490. c
  491.                   SEGSUP WRK7
  492.                   SEGSUP WRK9
  493.                   IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN
  494.                   INTERR(1)=IB
  495.                   INTERR(2)=IGAU
  496.                   REAERR(1)=TLIFE
  497.                   CALL ERREUR(-279)
  498.                   ENDIF
  499.                   DTOPTI  = MIN(DTOPTI,DTT)
  500.                   NINCMA = MAX(NINCMA,NSSINC)
  501.                   NCOMP = NCOMP + 1
  502.                   TSOM = TSOM + DTT
  503.                   NSOM = NSOM + NSSINC
  504.                   NINV = NINV + INV
  505.                   TCAR = TCAR + DTT* DTT
  506.                   IF(KERRE.NE.0) THEN
  507.                      KERR1=1
  508.                   END IF
  509.                   END IF
  510. c
  511. c        modele plastique d'endommagement de lemaitre
  512. c        ++++++++++++++++++++++++++++++++++++++++++++
  513. c  traitement du materiau qui depend eventuellement de la temperature
  514. c  ------------------------------------------------------------------
  515.             ELSE IF (INPLAS.EQ.26) THEN
  516.                         NYOG=IABLO1(1)
  517.                         NYNU=IABLO1(2)
  518.                         NYRHO=IABLO1(3)
  519.                         NYALFA=IABLO1(4)
  520.                         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  521.      +                        AND.IFOUR.EQ.-2) THEN
  522.                           INTMAT=10
  523.                         ELSE
  524.                           INTMAT=9
  525.                         ENDIF
  526.                         IF (NTABO1.EQ.INTMAT) THEN
  527.                            NNKX=1
  528.                            NYKX=IABLO1(5)
  529.                            IEPS=0
  530.                         ELSE
  531.                            NNKX=IABLO1(5)
  532.                            NYKX=0
  533.                            DO I=1,NNKX
  534.                              NYKX=NYKX+(2*IABLO1(5+I))
  535.                            ENDDO
  536.                            NYKX=NYKX+NNKX
  537.                            IEPS=1
  538.                         ENDIF
  539.                         IORIGI=6+(IEPS*NNKX)
  540.                         NYN=IABLO1(IORIGI)
  541.                         NYM=IABLO1(IORIGI+1)
  542.                         NYKK=IABLO1(IORIGI+2)
  543.                         NYSMAX=0
  544.                         NYALF1=0
  545.                         NYBET1=0
  546.                         NYR=0
  547.                         NYA=0
  548.                         NSIGY=0
  549.                         SEGINI WRK9
  550.                         CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  551.                         SEGSUP WR10
  552. c
  553. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  554. c *** on n' ecoule pas
  555. c
  556.                CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  557.                IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  558.                   DO 1115 IEN=1,NVARI
  559.                      VARF(IEN)=VAR0(IEN)
  560. 1115              continue
  561.                   VARF(3)=1.D0
  562.                   CALL ZDANUL(SIGF,NSTRS)
  563.                   CALL ZDANUL(DEFP,NSTRS)
  564.                   SEGSUP WRK9
  565.                ELSE
  566. c ----------------------------------------------------------------------
  567. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  568. c                     p est en supplement
  569. c ----------------------------------------------------------------------
  570.                   NNVARI=2
  571.                   IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  572.                     CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  573.                     NCOURB=2*NKX(1)
  574.                   ELSE
  575.                     NCOURB=NKX(1)
  576.                     DO I=1,NNKX
  577.                       if (nkx(i).ge.ncourb) ncourb=nkx(i)
  578.                     ENDDO
  579.                     NCOURB=4*NCOURB
  580.                   ENDIF
  581.                   IF (KERRE.EQ.0) THEN
  582.                     SEGINI WRK7
  583.       CALL ENDOM(WRK0,WR00,WRK1,WRK6,WRK7,WRK8,WRK9,WTRAV,NSTRSS,
  584.      1 NMATT,ICARA,INPLAS,NVARI,PRECIS,MFR1,IFOURB,KERRE,NNVARI,
  585.      2 NYOG,NYNU,NYRHO,NYALFA,NNKX,NYKX,NCOURB,NYN,NYM,NYKK,TETA1,
  586.      3       TETA2,TREFA,ITHHER,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  587.      4                  MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI)
  588.                     SEGSUP WRK7
  589.                     SEGSUP WRK9
  590.                     IF(KERRE.GT.200) THEN
  591.                        KERR1=1
  592.                     END IF
  593.                   END IF
  594.                END IF
  595.             ELSE
  596.                KERRE = 99
  597.             ENDIF
  598. *
  599. *   Erreurs
  600. *      - problèmes de convergence
  601. *
  602.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  603. *
  604. *      - autres problèmes
  605. *
  606.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  607.      .           KERR1,KERRE)
  608.  1998 IF (KERRE.GT.0) THEN
  609.          IF (LOGVIS) SEGSUP WRK8
  610.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  611.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  612.             SEGSUP WRK4
  613.          ENDIF
  614.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  615.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  616.      1     .OR.MFR.EQ.33)) THEN
  617.            SEGDES MINTE2
  618.            SEGSUP WRK22
  619.          ENDIF
  620.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  621.             SEGDES MELVA3
  622.             SEGDES MELVA4
  623.             SEGDES MELVA5
  624.             SEGDES MCHAM3
  625.             SEGDES MCHAM4
  626.             SEGDES MCHAM5
  627.          ENDIF
  628.          RETURN
  629.       ENDIF
  630. c
  631. c
  632. c     remplissage du segment contenant les contraintes a la fin
  633. *     ( rearrangement pour milieu poreux ),
  634. c     les variables internes finales
  635. c     et les increments de deformations plastiques
  636. c
  637.       CALL DEFSIG(MFR,NDEF,
  638.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  639.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  640.      .     CMATE,MATE,MELE,KERRER)
  641.       IF (KERRER.GT.0) GOTO 1000
  642. c
  643. c
  644. c    fin de la boucle sur les points de gauss
  645. c
  646. 1100     continue
  647. c
  648. c    special poutres et tuyaux  sauf timoschenko
  649. c
  650.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  651. c
  652. c     fin de la boucle sur les elements
  653. c
  654. 1000  continue
  655. c
  656. *  FIN: modèles visqueux, on stocke le pas de temps
  657. *  optimal en indice 'dtopti'
  658. *
  659.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  660.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  661.       IF (LOGVIS) SEGSUP WRK8
  662. *
  663.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  664.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  665.          SEGSUP WRK4
  666.       END IF
  667.       IF(INPLAS.EQ.26) THEN
  668.         SEGSUP WRK6,WRK8
  669.       END IF
  670.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  671.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  672.      1     .OR.MFR.EQ.33)) THEN
  673.         SEGDES MINTE2
  674.         SEGSUP WRK22
  675.       ENDIF
  676. *
  677.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  678.             SEGDES MELVA3
  679.             SEGDES MELVA4
  680.             SEGDES MELVA5
  681.             SEGDES MCHAM3
  682.             SEGDES MCHAM4
  683.             SEGDES MCHAM5
  684.       ENDIF
  685.  
  686.       RETURN
  687.       END
  688.  
  689.  
  690.  

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