Télécharger la plaquette Cast3M


fr en

Télécharger ecou21.eso

Retour à la liste

Numérotation des lignes : 

ecou21

  1. C ECOU21    SOURCE    CB215821  24/04/12    21:15:41     11897          
  2.       SUBROUTINE ECOU21(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. *  CAS DES CERAMIQUES
  10. ***********************************************************************
  11. * entrees :
  12. *
  13. *  mate   = numero de materiau elastique
  14. *  inplas = numero de materiau inelastique
  15. *  mele   = numero  element fini
  16. *  ipmail = pointeur du maillage
  17. *  nbptel = nombre de points par element
  18. *  imat   = pointeur sur un segment mptval de materiau (utilise par calsig)
  19. *  icar   = pointeur sur un segment mptval de caracteristiques
  20. *           geometriques (utilise par calsig)
  21. *  numat  = nb de composantes du melval de imat
  22. *  nucar  = nb de composantes du melval de icar
  23. *  ivastr =pointeur sur un segment mptval de contraintes
  24. *  ivari  =pointeur sur un segment mptval de variables internes
  25. *  ivadef =pointeur sur un segment mptval de deformations
  26. *  ivads  =pointeur sur un segment mptval de contraintes  (increments)
  27. *  ivamat =pointeur sur un segment mptval de materiau
  28. *  ivacar =pointeur sur un segment mptval de cacarteristiques geometrique
  29. *  iph1  = pointeur sur un mchaml de temperatures au debut du pas
  30. *  iph2  = pointeur sur un mchaml de temperatures a la fin du pas
  31. *  iph3  = pointeur sur un mchaml de temperatures de reference
  32. *  ithher = 0 si pas de chargement thermique
  33. *         = 1 si chargement thermique mais materiau constant
  34. *         = 2 si chargement thermique et mat. dependant de la temperature
  35. *  ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  36. *        endommageables de lemaitre quand ils dependent de la temperature
  37. *  lhook  =taille de la matrice de hooke
  38. *  nstrs  =nombre de composantes de contraintes
  39. *  nvari  =nombre de composantes de variables internes
  40. *  nmatt  =nombre de composnates de proprietes de materiau
  41. *  ncarr  =nombre de composnates de caracteristiques geometriques
  42. *  cmate  =nom du materiau
  43. *  precis =precision dans les iterations internes
  44. *  jecher =0 ou 1 pour action dans ecoule
  45. *  jnoid  =0 ou 1 pour action dans ecoule
  46. *  ipotab =pointeur sur segment table
  47. *  istep  =indicateur d'action pour calcul nonlocal
  48. *        =0 dans le cas d'un calcul local (normal)
  49. *        =1 ou 2 dans le cas d'un calcul nonlocal
  50. *        =1 pour calcul des fonctions seuil uniquement
  51. *        =2 pour calcul des variables dissipatives a partir
  52. *           des fonctions seuil moyennees prealablement par nloc
  53. *
  54. * sorties :
  55. *  ivastf  =pointeur sur un segment mptval de contraintes
  56. *  ivarif  =pointeur sur un segment mptval de variables internes
  57. *  ivadep  =pointeur sur un segment mptval de deformations inelastiques
  58. *  kerre   =indicateur d'erreur
  59. *
  60. *  p dowlatyari  fev. 1992
  61. *
  62. *  c. la borderie fev 92 restructuration et reecriture de certains
  63. *                        passages pour une meilleure lisibilite
  64. *
  65. *                 avril 92 ajout istep pour le non local
  66. *                 dec 92 modif pour poutres timoschenko
  67. *
  68. ************************************************************************
  69.       IMPLICIT INTEGER(I-N)
  70.       IMPLICIT REAL*8(A-H,O-Z)
  71. *
  72.  
  73. -INC PPARAM
  74. -INC CCOPTIO
  75. -INC SMCHAML
  76. -INC SMELEME
  77. -INC SMCOORD
  78. -INC SMMODEL
  79. -INC SMINTE
  80. -INC CCHAMP
  81. -INC CECOU
  82. c=======================================================================
  83. c  la variable kerre regit les impressions d erreurs dans plast
  84. c      toutes erreurs de ecoule gerees dans ce sous programme
  85. c   kerre=0 tout ok
  86. c        de 1 a 6  s aligner sur valeurs donnees par ecoinc
  87. c     =   7  un element tuyau a une epaisseur nulle
  88. c     =  21  on ne trouve pas d intersection avec la surface de charge
  89. c     =  22  sig0 a l exterieur de la surface de charge
  90. c
  91. c             anomalies avec la courbe de traction
  92. c     =  30 limite elastique nulle
  93. c     =  31 trop de points
  94. c     =  32 pas assez de points
  95. c     =  33 pente incorrecte
  96. c     =  34 module d'young nul
  97. c     =  35 manque l'origine
  98. c     =  36 pente a l'origine non egale a e
  99. c     =  37 manque la courbe de traction
  100. c     =  38 nu devrait etre nul
  101. c
  102. c     =  48 donnees erronnees pour drucker-prager
  103. c     =  49 matrice singuliere dans iter internes drucker-prager
  104. c     =  51 pb dans drucker prager option non disponible
  105. c     =  52 pb dans drucker prager donnees incompatibles
  106. c     =  53 pb dans drucker prager solution impossible
  107. c     =  54 les valeurs admissibles pour istep sont 0 1 ou 2
  108. c     =  55 modele non implante en non local
  109. c     =  56 probleme dans l'integration du modele mazars
  110. c     =  57  ....
  111. c     =  58  ....
  112. c     =  59  ....
  113. c     =  60 pb donnees du cam-clay
  114. c
  115. c     =  99 cas non encore disponible
  116. c=======================================================================
  117. *
  118.       SEGMENT MPTVAL
  119.         INTEGER IPOS(NS)    ,NSOF(NS)
  120.         INTEGER      IVAL(NCOSOU)
  121.         CHARACTER*16 TYVAL(NCOSOU)
  122.       ENDSEGMENT
  123. *
  124.       SEGMENT WRK0
  125.        REAL*8 XMAT(NCXMAT)
  126.       ENDSEGMENT
  127. *
  128.       SEGMENT WR00
  129.        CHARACTER*16 TYMAT(NCXMAT)
  130.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  131.       ENDSEGMENT
  132. *
  133.       SEGMENT WRK1
  134.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  135.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  136.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  137.       ENDSEGMENT
  138. *
  139.       SEGMENT WRK2
  140.         REAL*8 TRAC(LTRAC)
  141.       ENDSEGMENT
  142. *
  143.       SEGMENT WRK22
  144.       REAL*8 XXE(3,NBNN)
  145.       ENDSEGMENT
  146. *
  147.       SEGMENT WRK3
  148.         REAL*8 WORK(LW),WORK2(LW2)
  149.       ENDSEGMENT
  150. *
  151.       SEGMENT WRK4
  152.         REAL*8 XE(3,NBBB)
  153.       ENDSEGMENT
  154. *
  155.       SEGMENT WRK5
  156.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  157.       ENDSEGMENT
  158. *
  159.       SEGMENT WRK6
  160.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  161.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  162.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  163.       ENDSEGMENT
  164. *
  165.       SEGMENT WRK7
  166.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  167.       ENDSEGMENT
  168. *
  169.       SEGMENT WRK8
  170.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  171.       ENDSEGMENT
  172. *
  173.       SEGMENT WRK9
  174.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  175.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  176.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  177.         REAL*8 SIGY(NSIGY)
  178.         INTEGER NKX(NNKX)
  179.       ENDSEGMENT
  180. *
  181.       SEGMENT WR10
  182.         INTEGER IABLO1(NTABO1)
  183.         REAL*8  TABLO2(NTABO2)
  184.       ENDSEGMENT
  185. *
  186.       SEGMENT WR11
  187.         INTEGER IABLO3(NTABO3)
  188.         REAL*8  TABLO4(NTABO4)
  189.       ENDSEGMENT
  190. *
  191.       SEGMENT WR12
  192.         REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  193.         REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  194.         REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  195.         REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  196.         REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  197.         REAL*8  SM8(NSTRS)
  198.       ENDSEGMENT
  199. *
  200.       SEGMENT WTRAV
  201.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  202.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  203.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  204.         REAL*8 XLOC(3,3),XGLOB(3,3)
  205.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  206.       ENDSEGMENT
  207. *
  208.       SEGMENT WPOUT
  209.          REAL*8  X(2),Y(2),Z(2)
  210.       ENDSEGMENT
  211.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  212.       LOGICAL LUNI1,LUNI2
  213.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  214.       DIMENSION NWA(9)
  215.       DIMENSION SIG01(4),VAR01(36)
  216. *
  217.       CHARACTER*72 CHARRE
  218.       CHARACTER*8  CMATE
  219. c
  220. *
  221. *   mise à disposition des temperatures tini tfin tref
  222. *   aux points de gauss
  223. *
  224.          TETA1=-1.E35
  225.          TETA2=-1.E35
  226.          TETREF=-1.E35
  227.          TREFA=-1.E35
  228.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  229.             MCHAM3=IPH1
  230.             MCHAM4=IPH2
  231.             MCHAM5=IPH3
  232.             SEGACT MCHAM3
  233.             SEGACT MCHAM4
  234.             SEGACT MCHAM5
  235.             MELVA3=MCHAM3.IELVAL(1)
  236.             MELVA4=MCHAM4.IELVAL(1)
  237.             MELVA5=MCHAM5.IELVAL(1)
  238.             SEGACT MELVA3
  239.             SEGACT MELVA4
  240.             SEGACT MELVA5
  241.          ENDIF
  242. c
  243. c   Initialisations de variables
  244. c---------------------------------
  245. c      - mise à zéro des variables du commun NECOU si besoin
  246. c      - modèles viscoplastiques:
  247. c                  . on récupère le pas de temps
  248. c                  . on récupère le nombre maximal de sous-pas
  249. c                  . on met IND=1
  250. c      - initialisation des dimensions des tableaux des segments
  251. c   Sorties: en plus du commun NECOU, on range les autres données
  252. c   initialisées dans les COMMON IECOU et XECOU
  253. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  254. c   argument de DEFINI
  255. c
  256.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  257.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  258.      .           IPMAIL,IVAMAT,
  259.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  260.      .           LUNI1,LUNI2,LW,KERRE)
  261.       IF (KERRE.EQ.999) RETURN
  262. c
  263.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  264.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  265.      1     .OR.MFR.EQ.33)) THEN
  266.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  267.         MINTE2=IPTR1
  268.         SEGACT MINTE2
  269.         SEGINI WRK22
  270.       ENDIF
  271. c
  272.       IF (LOGVIS) SEGINI WRK8
  273.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  274.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  275.          SEGINI WRK4
  276.       ENDIF
  277. c
  278.       SEGINI WTRAV
  279. *
  280. *       boucle sur les elements
  281. *
  282.       DO 1000 IB=1,NBELEM
  283. *
  284. *  Matériaux orthotropes, anisotropes et unidirectionnels
  285. *  en formulation massive:
  286. *     - on cherche  les coordonnees des noeuds de l element ib
  287. *     - calcul des axes locaux
  288. *  Cas particulier de l'ACIER_UNI
  289. *
  290.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  291.      .     MELEME,WRK4,WRK22,WTRAV)
  292. *
  293. *       boucle sur les points de gauss
  294. *
  295.          DO 1100 IGAU=1,NBPTEL
  296. *
  297. *  -recuperation de valmat et de valcar
  298. *  -on recupere les contraintes initiales
  299. *  -on recupere les variables internes
  300. *  -on recupere les deformations inelastiques initiales si besoin
  301. *  -on recupere les increments de deformations totales
  302. *  -on cherche la section de l'element ib
  303. *  -prise en compte de l'epaisseur et de l'excentrement
  304. *  dans le cas des coques minces avec ou sans cisaillement
  305. *  transverse
  306. *
  307.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  308.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  309.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  310.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  311. *
  312. *     on recupere les constantes du materiau
  313. *     en cas de reels, on a directement les valeurs
  314. *     en cas d'objets, on a les pointeurs eu guise de valeurs
  315. *     et on calcule les contraintes effectives en milieu poreux
  316. *
  317.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  318.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  319.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  320.      .        BID,BID2,KERR0)
  321.       IF (KERR0.EQ.99) THEN
  322.          KERRE=99
  323.          GOTO 1000
  324.       ELSE IF (KERR0.EQ.10) THEN
  325.          GOTO 1000
  326.       ENDIF
  327. *
  328. * >>>>>>>>>>   fin du traitement du materiau
  329. *
  330. *        on recupere les caracteristiques geometriques
  331. *
  332.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  333.      .           WRK1)
  334. *
  335. *          quelques impressions si iimpi = 99
  336. *
  337.       IF(IIMPI.EQ.99) THEN
  338. *          WRITE(IOIMP,66770) IB,IGAU
  339. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  340. *          WRITE(IOIMP,66771) MATE,INPLAS
  341. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  342. *          WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  343. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  344. *          WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  345. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  346. *          WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  347. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  348.           WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  349. 66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  350. *         IF(IVACAR.NE.0)THEN
  351. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  352. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  353. *         ENDIF
  354.        ENDIF
  355. *
  356. *   mise à disposition des temperatures tini tfin tref
  357. *   aux points de gauss
  358. *
  359.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  360.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  361.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  362.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  363.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  364.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  365.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  366.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  367.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  368.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  369.          ENDIF
  370. *
  371. *---------------------------------------------------------------------
  372. *
  373. *                  ecoulement
  374. *
  375. *---------------------------------------------------------------------
  376.             IF (INPLAS.EQ.65) THEN
  377. *
  378.                   SEGINI WRK7
  379.                   SEGINI WRK9
  380.                   IF((MFR.EQ.1).AND.(IFOMOD.EQ.2)) THEN
  381.                     IBIDO = 19
  382.                   ELSE
  383.                     IBIDO = 14
  384.                   ENDIF
  385. *                 CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION
  386. *                 CAD LORSQUE TTRAN = 0
  387. *
  388.                 IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN
  389. *
  390. * si le point de gauss est déjà endommagé par endommagement généralisé
  391. * on le traite simplement par ceraca
  392.         IF (VAR0(NVARI-1).EQ.1) THEN
  393.            CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  394.      1                 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,KERRE,
  395.      2                 ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  396.      3                 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,
  397.      4                 CRIGI)
  398.               IND=1
  399.         ELSE
  400. * si le point de gauss n'a pas un endommagement généralisé
  401. * on regarde si il a été fissuré
  402. * par ottosen et si non on applique le fluage puis ottosen
  403. *                             si oui on le traite par Ottosen
  404.                     MPTVAL=IVAMAT
  405.                     CALL OTOBO(VAR0,XMAT,IVAL,ITOTO,MFR)
  406.                  IF (ITOTO.EQ.0) THEN
  407.              CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  408.      1                   NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,
  409.      2                   KERRE,ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  410.      3                   EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,
  411.      4                   LHOOK,CRIGI)
  412.               IND=1
  413. * Ligne suivante à supprimer
  414. *      IF(IND.EQ.0) THEN
  415. *   on regarde si on a eu endommagement généralisé
  416. *   si on n'a pas eu endommagement généralisé on appele ottosen
  417.          IF (VARF(NVARI-1).NE.1) THEN
  418.               DO 161 I = 1,NVARI
  419.               VAR01(I) = VARF(I)
  420.  161        CONTINUE
  421.              DO 535 I=1,NSTRS
  422. *            PRINT *,'DEPST EPINF-EPIN0 ',I,DEPST(I),(EPINF(I)-EPIN0(I))
  423.                DEPST(I) = DEPST(I) -( EPINF(I)-EPIN0(I))
  424. C           On remplace SIGF par SIG0
  425.                SIG01(I) = SIG0(I)
  426.   535      CONTINUE
  427.              MPTVAL=IVAMAT
  428.              CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,IVAL,
  429.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  430.      &              IB,IGAU)
  431.              DO 541 I=1,NSTRS
  432.   541      CONTINUE
  433. C          on met à jour le variable interne EPSE commune aux deux modèles
  434.               VARF(1) = VARF(1)+VARF(NVARI)
  435. C                DO 537 I=1,NSTRS
  436. C               IF (SIGF(I).NE.SIG01(I)) THEN
  437. C              PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I)
  438. C               ENDIF
  439.  537         CONTINUE
  440.                 DO 538 I=1,NVARI
  441. C              IF (VARF(I).NE.VAR01(I)) THEN
  442. C              PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I)
  443. C             ENDIF
  444.  538         CONTINUE
  445.  
  446. C          On calcule l'increment de déformation du pas de temps
  447.              DO 536 I=1,NSTRS
  448. C             IF (DEFP(I).NE.0.)  PRINT *,'DEFP',DEFP(I)
  449.             DEFP(I) =DEFP(I)+( EPINF(I)-EPIN0(I))
  450.   536      CONTINUE
  451.               IND=0
  452.           ENDIF
  453. *         Ligne suivante à supprimer
  454. *           ENDIF
  455.               ELSE
  456.              MPTVAL=IVAMAT
  457.              CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  458.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  459.      &              IB,IGAU)
  460.               VARF(1) = VARF(1)+VARF(NVARI)
  461.               IND=0
  462.               ENDIF
  463.               ENDIF
  464. *
  465.                   ELSE
  466. *
  467. *                CAS OU ON PREND EN COMPTE LA TEMP2RATURE DE TRANSITION
  468. *
  469.                   IF(TETA2.GE.XMAT(IBIDO)) THEN
  470.                     MPTVAL=IVAMAT
  471.                     CALL OTOBO(VAR0,XMAT,IVAL,ITOTO,MFR)
  472.                  IF (ITOTO.EQ.0) THEN
  473.              CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  474.      1                   NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,
  475.      2                   KERRE,ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  476.      3                   EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,
  477.      4                   LHOOK,CRIGI)
  478.              IND=1
  479.               ELSE
  480.              MPTVAL=IVAMAT
  481.              CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  482.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  483.      &              IB,IGAU)
  484.               VARF(1) = VARF(1)+VARF(NVARI)
  485.              IND=0
  486.               ENDIF
  487.                   ELSE
  488.         IF (VAR0(NVARI-1).EQ.1) THEN
  489.            CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  490.      1                 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,KERRE,
  491.      2                 ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  492.      3                 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,
  493.      4                 CRIGI)
  494.              IND=1
  495.         ELSE
  496.              MPTVAL=IVAMAT
  497.              CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  498.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  499.      &              IB,IGAU)
  500.               VARF(1) = VARF(1)+VARF(NVARI)
  501.              IND=0
  502.          ENDIF
  503.          ENDIF
  504.          ENDIF
  505.           IF (MFR1.EQ.17) THEN
  506.             IF (KERRE.NE.0.AND.NSSINC.EQ.1) THEN
  507.               CALL ERREUR(KERRE)
  508.              ENDIF
  509.           ENDIF
  510.  
  511.                   SEGSUP WRK7
  512.                   SEGSUP WRK9
  513.                   DTOPTI  = MIN(DTOPTI,DTT)
  514.                   NINCMA = MAX(NINCMA,NSSINC)
  515.                   NCOMP = NCOMP + 1
  516.                   TSOM = TSOM + DTT
  517.                   NSOM = NSOM + NSSINC
  518.                   NINV = NINV + INV
  519.                   TCAR = TCAR + DTT* DTT
  520.                   IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  521.                      KERR1=1
  522.                   ENDIF
  523. c
  524.             ELSE IF (INPLAS.EQ.74) THEN
  525. *
  526. *                        CHAINE DE MAXWELL
  527. *
  528. *     on commence par recuperer le nombre d'elements dans la chaine
  529. *     et les proprietes et variables internes associees a des objets
  530.                CALL MAXTRA(WRK0,WRK1,WRK5,WR12,WTRAV,IB,IGAU,
  531.      &          NBGMAT,NELMAT,NPINT,NWA,NSTRSS,NCHAIN,CMATE,MFR)
  532.                IF(IERR.NE.0) THEN
  533.                  SEGSUP WR12
  534.                  GOTO 1789
  535.                ENDIF
  536.  
  537.         IF (MFR.EQ.3.OR.MFR.EQ.39) THEN
  538.                CALL MAXGEN(WRK0,WRK1,WRK5,WR12,MFR,
  539.      1           IB,IGAU,MELE,NCHAIN,KERRE,DT,CMATE,NWA,TEMP0)
  540.         ELSE
  541. *
  542. *         MLR 10/08/99
  543. *
  544. *         ON PASSE LE SEGMENT DE TRAVAIL WTRAV
  545. *
  546.                CALL MAXWEL(WRK0,WRK1,WRK5,WR12,MFR,
  547.      +           IB,IGAU,MELE,NCHAIN,KERRE,DT,CMATE,NWA,TEMP0)
  548.         ENDIF
  549. *
  550. *      ici gerer les erreurs
  551. *
  552.                CALL MAXTRB(WTRAV,WRK1,WRK5,WR12,NWA,NSTRSS,
  553.      &         NCHAIN,CMATE)
  554.                SEGSUP WR12
  555. *
  556. *      FIN DES DIFFERENTS MODELES
  557. *
  558.             ELSE
  559.                KERRE = 99
  560.             ENDIF
  561. *
  562. *   Erreurs
  563. *      - problèmes de convergence
  564. *
  565.  1789 CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  566. *
  567. *      - autres problèmes
  568. *
  569.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  570.      .           KERR1,KERRE)
  571.  1998 IF (KERRE.NE.0) THEN
  572.          IF (LOGVIS) SEGSUP WRK8
  573.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  574.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  575.             SEGSUP WRK4
  576.          ENDIF
  577.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  578.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  579.      1     .OR.MFR.EQ.33)) THEN
  580.            SEGDES MINTE2
  581.            SEGSUP WRK22
  582.          ENDIF
  583.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  584.             SEGDES MELVA3
  585.             SEGDES MELVA4
  586.             SEGDES MELVA5
  587.             SEGDES MCHAM3
  588.             SEGDES MCHAM4
  589.             SEGDES MCHAM5
  590.          ENDIF
  591.          RETURN
  592.       ENDIF
  593. c
  594. c
  595. c     remplissage du segment contenant les contraintes a la fin
  596. *     ( rearrangement pour milieu poreux ),
  597. c     les variables internes finales
  598. c     et les increments de deformations plastiques
  599. c
  600.       CALL DEFSIG(MFR,NDEF,
  601.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  602.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  603.      .     CMATE,MATE,MELE,KERRER)
  604.       IF (KERRER.NE.0) GOTO 1000
  605. c
  606. c    fin de la boucle sur les points de gauss
  607. c
  608. 1100     continue
  609. c
  610. c    special poutres et tuyaux  sauf timoschenko
  611. c
  612.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  613. c
  614. c     fin de la boucle sur les elements
  615. c
  616. 1000  continue
  617. c
  618. *  FIN: modèles visqueux, on stocke le pas de temps
  619. *  optimal en indice 'dtopti'
  620. *
  621.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  622.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  623.       IF (LOGVIS) SEGSUP WRK8
  624. *
  625. *
  626.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  627.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  628.          SEGSUP WRK4
  629.       END IF
  630.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  631.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  632.      1     .OR.MFR.EQ.33)) THEN
  633.         SEGDES MINTE2
  634.         SEGSUP WRK22
  635.       ENDIF
  636. *
  637.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  638.             SEGDES MELVA3
  639.             SEGDES MELVA4
  640.             SEGDES MELVA5
  641.             SEGDES MCHAM3
  642.             SEGDES MCHAM4
  643.             SEGDES MCHAM5
  644.       ENDIF
  645. *
  646.       RETURN
  647.       END
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  

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