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

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