Télécharger la plaquette Cast3M


fr en

Télécharger ecou70.eso

Retour à la liste

Numérotation des lignes : 

ecou70

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

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