Télécharger la plaquette Cast3M


fr en

Télécharger ecou25.eso

Retour à la liste

Numérotation des lignes : 

ecou25

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

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