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

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