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

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