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/02/21    21:16:03     12166          
  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. *
  208. *   mise à disposition des temperatures tini tfin tref
  209. *   aux points de gauss
  210. *
  211.          TETA1=-1.E35
  212.          TETA2=-1.E35
  213.          TETREF=-1.E35
  214.          TREFA=-1.E35
  215.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  216.             MCHAM3=IPH1
  217.             MCHAM4=IPH2
  218.             MCHAM5=IPH3
  219.             SEGACT MCHAM3
  220.             SEGACT MCHAM4
  221.             SEGACT MCHAM5
  222.             MELVA3=MCHAM3.IELVAL(1)
  223.             MELVA4=MCHAM4.IELVAL(1)
  224.             MELVA5=MCHAM5.IELVAL(1)
  225.             SEGACT MELVA3
  226.             SEGACT MELVA4
  227.             SEGACT MELVA5
  228.          ENDIF
  229. c
  230. c   Initialisations de variables
  231. c---------------------------------
  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. c
  250. c  Initialisations des segments de travail
  251. c
  252.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  253.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  254.      1     .OR.MFR.EQ.33)) THEN
  255.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  256.         MINTE2=IPTR1
  257.         SEGACT MINTE2
  258.         SEGINI WRK22
  259.       ENDIF
  260. c
  261.       IF (LOGVIS) SEGINI WRK8
  262. *
  263. *    initialisation des segments de travail
  264. *
  265.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  266.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  267.          SEGINI WRK4
  268.       ENDIF
  269.       IF(INPLAS.EQ.26)THEN
  270.         SEGINI WRK6
  271.       ENDIF
  272. c
  273.       SEGINI WTRAV
  274. *
  275. *       boucle sur les elements
  276. *
  277.       DO 1000 IB=1,NBELEM
  278. *
  279. *  Matériaux orthotropes, anisotropes et unidirectionnels
  280. *  en formulation massive:
  281. *     - on cherche  les coordonnees des noeuds de l element ib
  282. *     - calcul des axes locaux
  283. *  Cas particulier de l'ACIER_UNI
  284. *
  285.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  286.      .     MELEME,WRK4,WRK22,WTRAV)
  287. *
  288. *       boucle sur les points de gauss
  289. *
  290.          DO 1100 IGAU=1,NBPTEL
  291. *
  292. *  -recuperation de valmat et de valcar
  293. *  -on recupere les contraintes initiales
  294. *  -on recupere les variables internes
  295. *  -on recupere les deformations inelastiques initiales si besoin
  296. *  -on recupere les increments de deformations totales
  297. *  -on cherche la section de l'element ib
  298. *  -prise en compte de l'epaisseur et de l'excentrement
  299. *  dans le cas des coques minces avec ou sans cisaillement
  300. *  transverse
  301. *
  302.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  303.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  304.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  305.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  306. *
  307. *     on recupere les constantes du materiau
  308. *     calcul des contraintes effectives en milieu poreux
  309. *
  310.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  311.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  312.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  313.      .        BID,BID2,KERR0)
  314.       IF (KERR0.EQ.99) THEN
  315.          KERRE=99
  316.          GOTO 1000
  317.       ELSE IF (KERR0.EQ.10) THEN
  318.          GOTO 1000
  319.       ENDIF
  320. *
  321.           IF ((INPLAS.EQ.29.).OR.(INPLAS.EQ.26)) THEN
  322. *
  323. *        pour les materiaux endommageables de lemaitre traitement special
  324. *        car ils peuvent dependre de la temperature
  325. *
  326.           NTABO1 = 0
  327.           NTABO2 = 0
  328.           SEGINI WR10
  329.           DO 2200 JC=1,NMATT
  330.             IF (TYMAT(JC)(1:8).EQ.'REAL*8  ') THEN
  331.                          NTABO1=NTABO1+1
  332.                          NTABO2=NTABO2+1
  333.                          SEGADJ WR10
  334.                          IABLO1(NTABO1)=1
  335.                          TABLO2(NTABO2)=XMAT(JC)
  336.             ELSE IF (TYMAT(JC)(9:16).EQ.'EVOLUTIO') THEN
  337.                          CALL KSISIG(WRK0,JC,WRK2,NCOURB,KERRE)
  338.                          IF (KERRE.NE.0) GOTO 1990
  339.                          NTABO1=NTABO1+1
  340.                          NTABO=NTABO2
  341.                          NTABO2=NTABO2+(2*NCOURB)
  342.                          SEGADJ WR10
  343.                          IABLO1(NTABO1)=2*NCOURB
  344.                          DO 2050 JCC=1,NCOURB
  345.                                 TABLO2(NTABO+(2*JCC-1))=TRAC(2*JCC-1)
  346.                                 TABLO2(NTABO+(2*JCC))=TRAC(2*JCC)
  347. 2050                     continue
  348.             ELSE IF (TYMAT(JC)(9:16).EQ.'NUAGE   ') THEN
  349.                     NTABO3 = 0
  350.                     NTABO4 = 0
  351.                     SEGINI WR11
  352.                     CALL XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE)
  353.                     IF (KERRE.NE.0) THEN
  354.                                         SEGSUP WR10
  355.                                         SEGSUP WR11
  356.                                         KERR1=2
  357.                                         GOTO 1990
  358.                     ENDIF
  359. *                    segadj wr11
  360.                     NTABO=NTABO1
  361.                     NTABOO=NTABO2
  362.                     NTABO1=NTABO1+NTABO3+1
  363.                     NTABO2=NTABO2+NTABO4
  364.                     SEGADJ WR10
  365.                     IABLO1(NTABO+1)=NTABO3
  366.                     DO 2075 JCC=1,NTABO3
  367. 2075                       iablo1(ntabo+1+jcc)=iablo3(jcc)
  368.                     DO 2125 JCC=1,NTABO4
  369. 2125                       tablo2(ntaboo+jcc)=tablo4(jcc)
  370.                     SEGSUP WR11
  371.             ENDIF
  372. 2200      continue
  373.           ENDIF
  374. *
  375. * >>>>>>>>>>   fin du traitement du materiau
  376. *
  377. *        on recupere les caracteristiques geometriques
  378. *
  379.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  380.      .           WRK1)
  381. *      CALL DEFCAR(NCARR,ICARA,IB,IGAU,MFR,MELE,IVACAR,
  382. *     .           XCAR)
  383. *
  384. *          quelques impressions si iimpi = 99
  385. *
  386. *      IF(IIMPI.EQ.99) THEN
  387. *         WRITE(IOIMP,66770) IB,IGAU
  388. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  389. *         WRITE(IOIMP,66771) MATE,INPLAS
  390. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  391. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  392. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  393. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  394. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  395. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  396. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  397. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  398. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  399. *         IF(IVACAR.NE.0)THEN
  400. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  401. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  402. *         ENDIF
  403. *      ENDIF
  404. *
  405. *   mise à disposition des temperatures tini tfin tref
  406. *   aux points de gauss
  407. *
  408.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  409.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  410.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  411.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  412.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  413.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  414.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  415.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  416.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  417.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  418.          ENDIF
  419. *
  420. *
  421. *---------------------------------------------------------------------
  422. *
  423. *                  ecoulement selon les modeles
  424. *
  425. *---------------------------------------------------------------------
  426. *
  427. *
  428. *     modeles de viscoplasticite integres par consti
  429. *
  430.            IF ( INPLAS .EQ. 29) THEN
  431. *
  432.                         NYOG=IABLO1(1)
  433.                         NYNU=IABLO1(2)
  434.                         NYALFA=IABLO1(3)
  435.                         NYSMAX=IABLO1(4)
  436.                         NYN=IABLO1(5)
  437.                         NYM=IABLO1(6)
  438.                         NYKK=IABLO1(7)
  439.                         NYALF1=IABLO1(8)
  440.                         NYBET1=IABLO1(9)
  441.                         NYR=IABLO1(10)
  442.                         NYA=IABLO1(11)
  443.                         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  444.      +                        AND.IFOUR.EQ.-2) THEN
  445.                           INTMAT=15
  446.                         ELSE
  447.                           INTMAT=14
  448.                         ENDIF
  449.                         IF (NTABO1.EQ.INTMAT) THEN
  450.                            NNKX=1
  451.                            NYKX=IABLO1(12)
  452.                         ELSE
  453.                            NNKX=IABLO1(12)
  454.                            NYKX=0
  455.                            DO 1881 I=1,NNKX
  456.  1881                      NYKX=NYKX+(2*IABLO1(12+I))
  457.                            NYKX=NYKX+NNKX
  458.                         ENDIF
  459.                         NYRHO=IABLO1(NTABO1)
  460.                         NSIGY=1
  461.                         SEGINI WRK9
  462.                         CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  463.                         SEGSUP WR10
  464.                         IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  465.                            NCOURB=2*NKX(1)
  466.                         ELSE
  467.                            NCOURB=NKX(1)
  468.                            DO 1882 I=1,NNKX
  469.  1882                            IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  470.                                  NCOURB=2*NCOURB
  471.                        ENDIF
  472.                        SEGINI WRK7
  473.                   IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN
  474.                         CALL ZDANUL(SIGF,NSTRS)
  475.                         DO 1883 I=1,NVARI
  476.                           VARF(I) = VAR0(I)
  477.  1883                   CONTINUE
  478.                         VARF(3) =  1.0
  479.                         DO 1884 I=1,NSTRS
  480.                           EPINF(I) = EPIN0(I)
  481.  1884                   CONTINUE
  482.                         SEGSUP WRK7
  483.                         SEGSUP WRK9
  484.                   ELSE
  485.              CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  486.      1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT,
  487.      2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN,
  488.      3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1,
  489.      5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  490.      6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  491. c
  492. c
  493.                   SEGSUP WRK7
  494.                   SEGSUP WRK9
  495.                   IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN
  496.                   INTERR(1)=IB
  497.                   INTERR(2)=IGAU
  498.                   REAERR(1)=TLIFE
  499.                   CALL ERREUR(-279)
  500.                   ENDIF
  501.                   DTOPTI  = MIN(DTOPTI,DTT)
  502.                   NINCMA = MAX(NINCMA,NSSINC)
  503.                   NCOMP = NCOMP + 1
  504.                   TSOM = TSOM + DTT
  505.                   NSOM = NSOM + NSSINC
  506.                   NINV = NINV + INV
  507.                   TCAR = TCAR + DTT* DTT
  508.                   IF(KERRE.NE.0) THEN
  509.                      KERR1=1
  510.                   END IF
  511.                   END IF
  512. c
  513. c        modele plastique d'endommagement de lemaitre
  514. c        ++++++++++++++++++++++++++++++++++++++++++++
  515. c  traitement du materiau qui depend eventuellement de la temperature
  516. c  ------------------------------------------------------------------
  517.             ELSE IF (INPLAS.EQ.26) THEN
  518.                         NYOG=IABLO1(1)
  519.                         NYNU=IABLO1(2)
  520.                         NYRHO=IABLO1(3)
  521.                         NYALFA=IABLO1(4)
  522.                         IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  523.      +                        AND.IFOUR.EQ.-2) THEN
  524.                           INTMAT=10
  525.                         ELSE
  526.                           INTMAT=9
  527.                         ENDIF
  528.                         IF (NTABO1.EQ.INTMAT) THEN
  529.                            NNKX=1
  530.                            NYKX=IABLO1(5)
  531.                            IEPS=0
  532.                         ELSE
  533.                            NNKX=IABLO1(5)
  534.                            NYKX=0
  535.                            DO 1789 I=1,NNKX
  536.  1789                      NYKX=NYKX+(2*IABLO1(5+I))
  537.                            NYKX=NYKX+NNKX
  538.                            IEPS=1
  539.                         ENDIF
  540.                         IORIGI=6+(IEPS*NNKX)
  541.                         NYN=IABLO1(IORIGI)
  542.                         NYM=IABLO1(IORIGI+1)
  543.                         NYKK=IABLO1(IORIGI+2)
  544.                         NYSMAX=0
  545.                         NYALF1=0
  546.                         NYBET1=0
  547.                         NYR=0
  548.                         NYA=0
  549.                         NSIGY=0
  550.                         SEGINI WRK9
  551.                         CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  552.                         SEGSUP WR10
  553. c
  554. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  555. c *** on n' ecoule pas
  556. c
  557.                CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  558.                IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  559.                   DO 1115 IEN=1,NVARI
  560.                      VARF(IEN)=VAR0(IEN)
  561. 1115              continue
  562.                   VARF(3)=1.D0
  563.                   CALL ZDANUL(SIGF,NSTRS)
  564.                   CALL ZDANUL(DEFP,NSTRS)
  565.                   SEGSUP WRK9
  566.                ELSE
  567. c ----------------------------------------------------------------------
  568. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  569. c                     p est en supplement
  570. c ----------------------------------------------------------------------
  571.                   NNVARI=2
  572.                   IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  573.                     CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  574.                     NCOURB=2*NKX(1)
  575.                   ELSE
  576.                     NCOURB=NKX(1)
  577.                     DO 1119 I=1,NNKX
  578. 1119                  if (nkx(i).ge.ncourb) ncourb=nkx(i)
  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. *
  664.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  665.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  666.          SEGSUP WRK4
  667.       END IF
  668.       IF(INPLAS.EQ.26) THEN
  669.         SEGSUP WRK6
  670.         SEGSUP WRK8
  671.       END IF
  672.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  673.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  674.      1     .OR.MFR.EQ.33)) THEN
  675.         SEGDES MINTE2
  676.         SEGSUP WRK22
  677.       ENDIF
  678. *
  679.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  680.             SEGDES MELVA3
  681.             SEGDES MELVA4
  682.             SEGDES MELVA5
  683.             SEGDES MCHAM3
  684.             SEGDES MCHAM4
  685.             SEGDES MCHAM5
  686.       ENDIF
  687. *
  688.       RETURN
  689.       END
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  
  696.  
  697.  
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  
  719.  
  720.  

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