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

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