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    OF166741  25/02/21    21:16:01     12166          
  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. -INC TMPTVAL
  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,NBBB)
  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 WR12
  188.         REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  189.         REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  190.         REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  191.         REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  192.         REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  193.         REAL*8  SM8(NSTRS)
  194.       ENDSEGMENT
  195. *
  196.       SEGMENT WTRAV
  197.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  198.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  199.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  200.         REAL*8 XLOC(3,3),XGLOB(3,3)
  201.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  202.       ENDSEGMENT
  203. *
  204.       SEGMENT WPOUT
  205.          REAL*8  X(2),Y(2),Z(2)
  206.       ENDSEGMENT
  207.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  208.       LOGICAL LUNI1,LUNI2
  209.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  210.       DIMENSION NWA(9)
  211.       DIMENSION SIG01(4),VAR01(36)
  212. *
  213.       CHARACTER*72 CHARRE
  214.       CHARACTER*8  CMATE
  215. c
  216. *
  217. *   mise à disposition des temperatures tini tfin tref
  218. *   aux points de gauss
  219. *
  220.          TETA1=-1.E35
  221.          TETA2=-1.E35
  222.          TETREF=-1.E35
  223.          TREFA=-1.E35
  224.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  225.             MCHAM3=IPH1
  226.             MCHAM4=IPH2
  227.             MCHAM5=IPH3
  228.             SEGACT MCHAM3
  229.             SEGACT MCHAM4
  230.             SEGACT MCHAM5
  231.             MELVA3=MCHAM3.IELVAL(1)
  232.             MELVA4=MCHAM4.IELVAL(1)
  233.             MELVA5=MCHAM5.IELVAL(1)
  234.             SEGACT MELVA3
  235.             SEGACT MELVA4
  236.             SEGACT MELVA5
  237.          ENDIF
  238. c
  239. c   Initialisations de variables
  240. c---------------------------------
  241. c      - mise à zéro des variables du commun NECOU si besoin
  242. c      - modèles viscoplastiques:
  243. c                  . on récupère le pas de temps
  244. c                  . on récupère le nombre maximal de sous-pas
  245. c                  . on met IND=1
  246. c      - initialisation des dimensions des tableaux des segments
  247. c   Sorties: en plus du commun NECOU, on range les autres données
  248. c   initialisées dans les COMMON IECOU et XECOU
  249. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  250. c   argument de DEFINI
  251. c
  252.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  253.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  254.      .           IPMAIL,IVAMAT,
  255.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  256.      .           LUNI1,LUNI2,LW,KERRE)
  257.       IF (KERRE.EQ.999) RETURN
  258. c
  259.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  260.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  261.      1     .OR.MFR.EQ.33)) THEN
  262.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  263.         MINTE2=IPTR1
  264.         SEGACT MINTE2
  265.         SEGINI WRK22
  266.       ENDIF
  267. c
  268.       IF (LOGVIS) SEGINI WRK8
  269.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  270.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  271.          SEGINI WRK4
  272.       ENDIF
  273. c
  274.       SEGINI WTRAV
  275. *
  276. *       boucle sur les elements
  277. *
  278.       DO 1000 IB=1,NBELEM
  279. *
  280. *  Matériaux orthotropes, anisotropes et unidirectionnels
  281. *  en formulation massive:
  282. *     - on cherche  les coordonnees des noeuds de l element ib
  283. *     - calcul des axes locaux
  284. *  Cas particulier de l'ACIER_UNI
  285. *
  286.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  287.      .     MELEME,WRK4,WRK22,WTRAV)
  288. *
  289. *       boucle sur les points de gauss
  290. *
  291.          DO 1100 IGAU=1,NBPTEL
  292. *
  293. *  -recuperation de valmat et de valcar
  294. *  -on recupere les contraintes initiales
  295. *  -on recupere les variables internes
  296. *  -on recupere les deformations inelastiques initiales si besoin
  297. *  -on recupere les increments de deformations totales
  298. *  -on cherche la section de l'element ib
  299. *  -prise en compte de l'epaisseur et de l'excentrement
  300. *  dans le cas des coques minces avec ou sans cisaillement
  301. *  transverse
  302. *
  303.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  304.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  305.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  306.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  307. *
  308. *     on recupere les constantes du materiau
  309. *     en cas de reels, on a directement les valeurs
  310. *     en cas d'objets, on a les pointeurs eu guise de valeurs
  311. *     et on calcule les contraintes effectives en milieu poreux
  312. *
  313.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  314.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  315.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  316.      .        BID,BID2,KERR0)
  317.       IF (KERR0.EQ.99) THEN
  318.          KERRE=99
  319.          GOTO 1000
  320.       ELSE IF (KERR0.EQ.10) THEN
  321.          GOTO 1000
  322.       ENDIF
  323. *
  324. * >>>>>>>>>>   fin du traitement du materiau
  325. *
  326. *        on recupere les caracteristiques geometriques
  327. *
  328.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  329.      .           WRK1)
  330. *
  331. *          quelques impressions si iimpi = 99
  332. *
  333.       IF(IIMPI.EQ.99) THEN
  334. *          WRITE(IOIMP,66770) IB,IGAU
  335. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  336. *          WRITE(IOIMP,66771) MATE,INPLAS
  337. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  338. *          WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  339. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  340. *          WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  341. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  342. *          WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  343. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  344.           WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  345. 66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  346. *         IF(IVACAR.NE.0)THEN
  347. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  348. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  349. *         ENDIF
  350.        ENDIF
  351. *
  352. *   mise à disposition des temperatures tini tfin tref
  353. *   aux points de gauss
  354. *
  355.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  356.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  357.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  358.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  359.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  360.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  361.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  362.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  363.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  364.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  365.          ENDIF
  366. *
  367. *---------------------------------------------------------------------
  368. *
  369. *                  ecoulement
  370. *
  371. *---------------------------------------------------------------------
  372.             IF (INPLAS.EQ.65) THEN
  373. *
  374.                   SEGINI WRK7
  375.                   SEGINI WRK9
  376.                   IF((MFR.EQ.1).AND.(IFOMOD.EQ.2)) THEN
  377.                     IBIDO = 19
  378.                   ELSE
  379.                     IBIDO = 14
  380.                   ENDIF
  381. *                 CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION
  382. *                 CAD LORSQUE TTRAN = 0
  383. *
  384.                 IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN
  385. *
  386. * si le point de gauss est déjà endommagé par endommagement généralisé
  387. * on le traite simplement par ceraca
  388.         IF (VAR0(NVARI-1).EQ.1) THEN
  389.            CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  390.      1                 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,KERRE,
  391.      2                 ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  392.      3                 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,
  393.      4                 CRIGI)
  394.               IND=1
  395.         ELSE
  396. * si le point de gauss n'a pas un endommagement généralisé
  397. * on regarde si il a été fissuré
  398. * par ottosen et si non on applique le fluage puis ottosen
  399. *                             si oui on le traite par Ottosen
  400.                     MPTVAL=IVAMAT
  401.                     CALL OTOBO(VAR0,XMAT,IVAL,ITOTO,MFR)
  402.                  IF (ITOTO.EQ.0) THEN
  403.              CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  404.      1                   NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,
  405.      2                   KERRE,ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  406.      3                   EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,
  407.      4                   LHOOK,CRIGI)
  408.               IND=1
  409. * Ligne suivante à supprimer
  410. *      IF(IND.EQ.0) THEN
  411. *   on regarde si on a eu endommagement généralisé
  412. *   si on n'a pas eu endommagement généralisé on appele ottosen
  413.          IF (VARF(NVARI-1).NE.1) THEN
  414.               DO 161 I = 1,NVARI
  415.               VAR01(I) = VARF(I)
  416.  161        CONTINUE
  417.              DO 535 I=1,NSTRS
  418. *            PRINT *,'DEPST EPINF-EPIN0 ',I,DEPST(I),(EPINF(I)-EPIN0(I))
  419.                DEPST(I) = DEPST(I) -( EPINF(I)-EPIN0(I))
  420. C           On remplace SIGF par SIG0
  421.                SIG01(I) = SIG0(I)
  422.   535      CONTINUE
  423.              MPTVAL=IVAMAT
  424.              CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,IVAL,
  425.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  426.      &              IB,IGAU)
  427.              DO 541 I=1,NSTRS
  428.   541      CONTINUE
  429. C          on met à jour le variable interne EPSE commune aux deux modèles
  430.               VARF(1) = VARF(1)+VARF(NVARI)
  431. C                DO 537 I=1,NSTRS
  432. C               IF (SIGF(I).NE.SIG01(I)) THEN
  433. C              PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I)
  434. C               ENDIF
  435.  537         CONTINUE
  436.                 DO 538 I=1,NVARI
  437. C              IF (VARF(I).NE.VAR01(I)) THEN
  438. C              PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I)
  439. C             ENDIF
  440.  538         CONTINUE
  441.  
  442. C          On calcule l'increment de déformation du pas de temps
  443.              DO 536 I=1,NSTRS
  444. C             IF (DEFP(I).NE.0.)  PRINT *,'DEFP',DEFP(I)
  445.             DEFP(I) =DEFP(I)+( EPINF(I)-EPIN0(I))
  446.   536      CONTINUE
  447.               IND=0
  448.           ENDIF
  449. *         Ligne suivante à supprimer
  450. *           ENDIF
  451.               ELSE
  452.              MPTVAL=IVAMAT
  453.              CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  454.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  455.      &              IB,IGAU)
  456.               VARF(1) = VARF(1)+VARF(NVARI)
  457.               IND=0
  458.               ENDIF
  459.               ENDIF
  460. *
  461.                   ELSE
  462. *
  463. *                CAS OU ON PREND EN COMPTE LA TEMP2RATURE DE TRANSITION
  464. *
  465.                   IF(TETA2.GE.XMAT(IBIDO)) THEN
  466.                     MPTVAL=IVAMAT
  467.                     CALL OTOBO(VAR0,XMAT,IVAL,ITOTO,MFR)
  468.                  IF (ITOTO.EQ.0) THEN
  469.              CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  470.      1                   NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,
  471.      2                   KERRE,ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  472.      3                   EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,
  473.      4                   LHOOK,CRIGI)
  474.              IND=1
  475.               ELSE
  476.              MPTVAL=IVAMAT
  477.              CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  478.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  479.      &              IB,IGAU)
  480.               VARF(1) = VARF(1)+VARF(NVARI)
  481.              IND=0
  482.               ENDIF
  483.                   ELSE
  484.         IF (VAR0(NVARI-1).EQ.1) THEN
  485.            CALL CERACA(WRK0,WRK1,WRK5,WTRAV,INPLAS,MFR1,DT,NSTRSS,
  486.      1                 NVARI,PRECIS,MSOUPA,JECHER,DTT,NSSINC,INV,KERRE,
  487.      2                 ICARA,IFOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  488.      3                 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,
  489.      4                 CRIGI)
  490.              IND=1
  491.         ELSE
  492.              MPTVAL=IVAMAT
  493.              CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  494.      &              NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  495.      &              IB,IGAU)
  496.               VARF(1) = VARF(1)+VARF(NVARI)
  497.              IND=0
  498.          ENDIF
  499.          ENDIF
  500.          ENDIF
  501.           IF (MFR1.EQ.17) THEN
  502.             IF (KERRE.NE.0.AND.NSSINC.EQ.1) THEN
  503.               CALL ERREUR(KERRE)
  504.              ENDIF
  505.           ENDIF
  506.  
  507.                   SEGSUP WRK7
  508.                   SEGSUP WRK9
  509.                   DTOPTI  = MIN(DTOPTI,DTT)
  510.                   NINCMA = MAX(NINCMA,NSSINC)
  511.                   NCOMP = NCOMP + 1
  512.                   TSOM = TSOM + DTT
  513.                   NSOM = NSOM + NSSINC
  514.                   NINV = NINV + INV
  515.                   TCAR = TCAR + DTT* DTT
  516.                   IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  517.                      KERR1=1
  518.                   ENDIF
  519. c
  520.             ELSE IF (INPLAS.EQ.74) THEN
  521. *
  522. *                        CHAINE DE MAXWELL
  523. *
  524. *     on commence par recuperer le nombre d'elements dans la chaine
  525. *     et les proprietes et variables internes associees a des objets
  526.                CALL MAXTRA(WRK0,WRK1,WRK5,WR12,WTRAV,IB,IGAU,
  527.      &          NBGMAT,NELMAT,NPINT,NWA,NSTRSS,NCHAIN,CMATE,MFR)
  528.                IF(IERR.NE.0) THEN
  529.                  SEGSUP WR12
  530.                  GOTO 1789
  531.                ENDIF
  532.  
  533.         IF (MFR.EQ.3.OR.MFR.EQ.39) THEN
  534.                CALL MAXGEN(WRK0,WRK1,WRK5,WR12,MFR,
  535.      1           IB,IGAU,MELE,NCHAIN,KERRE,DT,CMATE,NWA,TEMP0)
  536.         ELSE
  537. *
  538. *         MLR 10/08/99
  539. *
  540. *         ON PASSE LE SEGMENT DE TRAVAIL WTRAV
  541. *
  542.                CALL MAXWEL(WRK0,WRK1,WRK5,WR12,MFR,
  543.      +           IB,IGAU,MELE,NCHAIN,KERRE,DT,CMATE,NWA,TEMP0)
  544.         ENDIF
  545. *
  546. *      ici gerer les erreurs
  547. *
  548.                CALL MAXTRB(WTRAV,WRK1,WRK5,WR12,NWA,NSTRSS,
  549.      &         NCHAIN,CMATE)
  550.                SEGSUP WR12
  551. *
  552. *      FIN DES DIFFERENTS MODELES
  553. *
  554.             ELSE
  555.                KERRE = 99
  556.             ENDIF
  557. *
  558. *   Erreurs
  559. *      - problèmes de convergence
  560. *
  561.  1789 CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  562. *
  563. *      - autres problèmes
  564. *
  565.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  566.      .           KERR1,KERRE)
  567.  1998 IF (KERRE.NE.0) THEN
  568.          IF (LOGVIS) SEGSUP WRK8
  569.          SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  570.          IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  571.             SEGSUP WRK4
  572.          ENDIF
  573.          IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  574.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  575.      1     .OR.MFR.EQ.33)) THEN
  576.            SEGDES MINTE2
  577.            SEGSUP WRK22
  578.          ENDIF
  579.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  580.             SEGDES MELVA3
  581.             SEGDES MELVA4
  582.             SEGDES MELVA5
  583.             SEGDES MCHAM3
  584.             SEGDES MCHAM4
  585.             SEGDES MCHAM5
  586.          ENDIF
  587.          RETURN
  588.       ENDIF
  589. c
  590. c     remplissage du segment contenant les contraintes a la fin
  591. *     ( rearrangement pour milieu poreux ),
  592. c     les variables internes finales
  593. c     et les increments de deformations plastiques
  594. c
  595.       CALL DEFSIG(MFR,NDEF,
  596.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  597.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  598.      .     CMATE,MATE,MELE,KERRER)
  599.       IF (KERRER.NE.0) GOTO 1000
  600. c
  601. c    fin de la boucle sur les points de gauss
  602. c
  603. 1100     continue
  604. c
  605. c    special poutres et tuyaux  sauf timoschenko
  606. c
  607.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  608. c
  609. c     fin de la boucle sur les elements
  610. c
  611. 1000  continue
  612. c
  613. *  FIN: modèles visqueux, on stocke le pas de temps
  614. *  optimal en indice 'dtopti'
  615. *
  616.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  617.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  618.       IF (LOGVIS) SEGSUP WRK8
  619. *
  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