Télécharger la plaquette Cast3M


fr en

Télécharger ecou60.eso

Retour à la liste

Numérotation des lignes : 

ecou60

  1. C ECOU60    SOURCE    OF166741  25/11/04    21:15:51     12349          
  2.       SUBROUTINE ECOU60(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  3.      1     NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  4.      1     IVADS,IVAMAT,IVACAR,
  5.      2     IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVARI,NMATT,NCARR,
  6.      3     CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  7.      4     N2EL,N2PTEL,NBNO,NBPGAU,LW,IVASTF,IVARIF,IVADEP,KERRE)
  8. ***********************************************************************
  9. *      ecoulement inelastique   appele par ecoul1
  10. c ppu  modif pour les materiaux unidirectionels en plastique
  11. *      MATERIAUX: -PLASTIQUES NON INTEGRES PAR ECOINC
  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,NBBB)
  152.       ENDSEGMENT
  153. *
  154.       SEGMENT WRK5
  155.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  156.       ENDSEGMENT
  157. *
  158.       SEGMENT WRK6
  159.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  160.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  161.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  162.       ENDSEGMENT
  163. *
  164.       SEGMENT WRK7
  165.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  166.       ENDSEGMENT
  167. *
  168.       SEGMENT WRK8
  169.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  170.       ENDSEGMENT
  171. *
  172.       SEGMENT WRK9
  173.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  174.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  175.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  176.         REAL*8 SIGY(NSIGY)
  177.         INTEGER NKX(NNKX)
  178.       ENDSEGMENT
  179. *
  180.       SEGMENT WR10
  181.         INTEGER IABLO1(NTABO1)
  182.         REAL*8  TABLO2(NTABO2)
  183.       ENDSEGMENT
  184. *
  185.       SEGMENT WR11
  186.         INTEGER IABLO3(NTABO3)
  187.         REAL*8  TABLO4(NTABO4)
  188.       ENDSEGMENT
  189. *
  190.       SEGMENT WTRAV
  191.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  192.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  193.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  194.         REAL*8 XLOC(3,3),XGLOB(3,3)
  195.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  196.       ENDSEGMENT
  197. *
  198.       SEGMENT WPOUT
  199.          REAL*8  X(2),Y(2),Z(2)
  200.       ENDSEGMENT
  201.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  202.       LOGICAL LUNI1,LUNI2
  203.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  204. *
  205.       CHARACTER*72 CHARRE
  206.       CHARACTER*8  CMATE
  207. *
  208. *   mise à disposition des temperatures tini tfin tref
  209. *   aux points de gauss
  210. *
  211.          TETA1=-1.E35
  212.          TETA2=-1.E35
  213.          TETREF=-1.E35
  214.          TREFA=-1.E35
  215.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  216.             MCHAM3=IPH1
  217.             MCHAM4=IPH2
  218.             MCHAM5=IPH3
  219.             SEGACT MCHAM3
  220.             SEGACT MCHAM4
  221.             SEGACT MCHAM5
  222.             MELVA3=MCHAM3.IELVAL(1)
  223.             MELVA4=MCHAM4.IELVAL(1)
  224.             MELVA5=MCHAM5.IELVAL(1)
  225.             SEGACT MELVA3
  226.             SEGACT MELVA4
  227.             SEGACT MELVA5
  228.          ENDIF
  229.  
  230. c   Initialisations de variables
  231. c---------------------------------
  232. c      - mise à zéro des variables du commun NECOU si besoin
  233. c      - modèles viscoplastiques:
  234. c                  . on récupère le pas de temps
  235. c                  . on récupère le nombre maximal de sous-pas
  236. c                  . on met IND=1
  237. c      - initialisation des dimensions des tableaux des segments
  238. c   Sorties: en plus du commun NECOU, on range les autres données
  239. c   initialisées dans les COMMON IECOU et XECOU
  240. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  241. c   argument de DEFINI
  242. c
  243.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  244.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  245.      .           IPMAIL,IVAMAT,
  246.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  247.      .           LUNI1,LUNI2,LW,KERRE)
  248.       IF (KERRE.EQ.999) RETURN
  249. c
  250. c  Initialisations des segments de travail
  251. c
  252.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  253.  
  254.       WRK22 = 0
  255.       IPTR1 = 0
  256.       WRK4  = 0
  257.       WRK8  = 0
  258.  
  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 <- Cree dans RESPHT et actif
  269.         SEGINI WRK22
  270.       ENDIF
  271. c
  272.       IF (LOGVIS) SEGINI WRK8
  273.       IF (MFR.EQ.7.OR.MFR.EQ.13)THEN
  274.          NBBB=NBNN
  275.          SEGINI WRK4
  276.       ENDIF
  277. *
  278. *       boucle sur les elements
  279. *
  280.       DO 1000 IB=1,NBELEM
  281. *
  282. *  Matériaux orthotropes, anisotropes et unidirectionnels
  283. *  en formulation massive:
  284. *     - on cherche  les coordonnees des noeuds de l element ib
  285. *     - calcul des axes locaux
  286. *  Cas particulier de l'ACIER_UNI
  287. *
  288.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  289.      .     MELEME,WRK4,WRK22,WTRAV)
  290. *
  291. *       boucle sur les points de gauss
  292. *
  293.          DO 1100 IGAU=1,NBPTEL
  294. *
  295. *  -recuperation de valmat et de valcar
  296. *  -on recupere les contraintes initiales
  297. *  -on recupere les variables internes
  298. *  -on recupere les deformations inelastiques initiales si besoin
  299. *  -on recupere les increments de deformations totales
  300. *  -on cherche la section de l'element ib
  301. *  -prise en compte de l'epaisseur et de l'excentrement
  302. *  dans le cas des coques minces avec ou sans cisaillement
  303. *  transverse
  304. *
  305.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  306.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  307.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  308.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  309. *
  310. *     on recupere les constantes du materiau
  311. *     calcul des contraintes effectives en milieu poreux
  312. *
  313.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  314.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  315.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  316.      .        BID,BID2,KERR0)
  317.       IF (KERR0.EQ.99) THEN
  318.          KERRE=99
  319.          GOTO 1000
  320.       ELSE IF (KERR0.EQ.10) THEN
  321.          GOTO 1000
  322.       ENDIF
  323. *
  324. * >>>>>>>>>>   fin du traitement du materiau
  325. *
  326. *        on recupere les caracteristiques geometriques
  327. *
  328.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  329.      .           WRK1)
  330. *
  331. *          quelques impressions si iimpi = 99
  332. *
  333. *      IF(IIMPI.EQ.99) THEN
  334. *         WRITE(IOIMP,66770) IB,IGAU
  335. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  336. *         WRITE(IOIMP,66771) MATE,INPLAS
  337. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  338. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  339. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  340. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  341. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  342. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  343. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  344. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  345. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  346. *         IF(IVACAR.NE.0)THEN
  347. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  348. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  349. *         ENDIF
  350. *      ENDIF
  351. *
  352. *   mise à disposition des temperatures tini tfin tref
  353. *   aux points de gauss
  354. *
  355.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  356.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  357.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  358.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  359.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  360.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  361.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  362.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  363.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  364.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  365.          ENDIF
  366. *
  367. *---------------------------------------------------------------------
  368. *
  369. *                  ecoulement selon les modeles
  370. *
  371. *---------------------------------------------------------------------
  372. c
  373. c     modele linespring
  374. c
  375.             IF (INPLAS.EQ.2.OR.INPLAS.EQ.27) THEN
  376.                CALL LISPP0(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,KERRE,
  377.      1            NSTRSS,CMATE,N2EL,N2PTEL,MFR,IFOUR,IB,IGAU,EPAIST,
  378.      2             MELE,NPINT,NBGMAT,NBPGAU,NELMAT,SECT,LHOOK,CRIGI)
  379. c
  380. c     modele beton
  381. c
  382.             ELSE IF (INPLAS.EQ.9) THEN
  383.               MPTVAL=IVAMAT
  384.               iecou=0
  385.               inecou=0
  386.               iiecou=0
  387. **            CALL BETON(SIG0       ,DEPST,VAR0,XMAT,IVAL,NMATT,XCAR,
  388. **   1  DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,IFOURB,IB,IGAU,EPAIST,
  389. **   2  MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  390. **   3    ROTHOO,DDHOMU,CRIGI,DSIGT,SIGF,VARF,DEFP,MFR1,NBPGAU,KERRE,
  391. **   4    iecou,inecou,iiecou)
  392.               IF(KERRE.GT.200) THEN
  393.                  KERR1=1
  394.               END IF
  395. c
  396. c     tuyau fissure
  397. c
  398.             ELSE IF (INPLAS.EQ.14.OR.INPLAS.EQ.18) THEN
  399.                CALL TUFPLA(WRK1,WRK0,WRK2,WTRAV,INPLAS,PRECIS,
  400.      1                   NSTRSS,CMATE,N2EL,N2PTEL,MFR1,IFOURB,
  401.      2                       IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,
  402.      3                   NELMAT,NBPGAU,SECT,LHOOK,CRIGI,KERRE)
  403. c
  404. c     modele gauvain
  405. c
  406.             ELSE IF (INPLAS.EQ.16) THEN
  407. c
  408. c              on recupere les courbes moment-courbure
  409. c
  410.                CALL COTRA2(WRK0,WRK2,NCOURB,KERRE)
  411.                IF(KERRE.EQ.0) THEN
  412.                   CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  413.      1 MFR1,IFOURB,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,
  414.      2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,NSTRS,DEPST,VAR0,
  415.      3  XMAT,NCOMAT,XCAR,TRAC,NCOURB,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE)
  416.                   IF(KERRE.GT.200) THEN
  417.                      KERR1=1
  418.                   END IF
  419.                END IF
  420. c
  421. c     modele ubiquitous
  422. c
  423.             ELSE IF (INPLAS .EQ.28) THEN
  424.                iecou=0
  425.                inecou=0
  426.                iiecou=0
  427. **             CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  428. **   1 IFOURB,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  429. **   2 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,NSTRSS,DEPST,VAR0,
  430. **   3        XMAT,NBPGAU,NMATT,XCAR,DSIGT,SIGF,VARF,DEFP,MFR1,KERRE,
  431. **   4        iecou,inecou,iiecou)
  432.                IF(KERRE.GT.200) THEN
  433.                   KERR1=1
  434.                END IF
  435. c
  436. c     modele global
  437. c
  438.             ELSE IF(INPLAS.EQ.32)THEN
  439.               CALL COTRA3(KERRE,NSTRSS,CMATE,WTRAV,N2EL,N2PTEL,
  440.      1            MFR1,IFOURB,IB,IGAU,EPAIST,MELE,NPINT,NBGMAT,
  441.      2          NBPGAU,NELMAT,SECT,LHOOK,CRIGI,NMATT,WRK0,WRK1)
  442.                   IF(KERRE.LT.0) THEN
  443.                      INTERR(1)=IB
  444.                      INTERR(2)=IGAU
  445.                      IF(KERRE.LE.(-4)) THEN
  446.                         MOTERR(5:16) = 'CISAILLEMENT'
  447.                         CALL ERREUR(-283)
  448.                         KERRE = KERRE + 4
  449.                      END IF
  450.                      IF(KERRE.LE.(-2)) THEN
  451.                         MOTERR(5:16) = 'FLEXION'
  452.                         CALL ERREUR(-283)
  453.                         KERRE = KERRE + 2
  454.                      END IF
  455.                      IF(KERRE.LT.0) THEN
  456.                         MOTERR(5:16) = 'COMPRESSION'
  457.                         CALL ERREUR(-283)
  458.                         KERRE = 0
  459.                      END IF
  460.                   END IF
  461. c
  462. c     modele cam-clay
  463. c
  464.             ELSE IF (INPLAS.EQ.33) THEN
  465.               CALL CAMCLA(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NCOMAT,XCAR,
  466.      .                    SIGF,VARF,DEFP,PRECIS,MFR1,KERRE)
  467. c
  468.             ELSE IF (INPLAS .EQ. 34) THEN
  469. c
  470. c      modele de mohr coulomb pour les joints
  471. c
  472.               MPTVAL=IVAMAT
  473.                IF (IFOUR.EQ.2) THEN
  474. c
  475. c --------------------joints 3d
  476. c
  477.                  CALL COUL3(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  478.      &     DEPST,IFOURB,XMAT,NMATT,IVAL,DD,SIGF,DEFP,VARF,KERRE)
  479.                ELSE
  480. c
  481. c --------------------joints 2d
  482. c
  483.                  CALL COUL2(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  484.      &      DEPST,IFOURB,XMAT,NMATT,IVAL,DD,SIGF,DEFP,VARF,KERRE)
  485.                ENDIF
  486. c
  487.             ELSE IF (INPLAS .EQ. 35) THEN
  488. c
  489. c      modele de coulomb_dilatant  pour les joints 2d
  490. c
  491.                IF (IFOUR.NE.2) THEN
  492.                  CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,
  493.      &                       DEFP,KERRE)
  494.                ENDIF
  495. c
  496. c     modele de gurson
  497. c
  498.             ELSE IF (INPLAS .EQ. 38) THEN
  499.               iwrgur=0
  500.               CALL PRGURS(SIG0,NSTRSS,DEPST,VAR0,XMAT,NMATT,XCAR,
  501.      &           ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,iwrgur)
  502. c
  503.             ELSE IF (INPLAS .EQ. 36) THEN
  504. c
  505. c      modele beton_axi
  506. c
  507.               MPTVAL=IVAMAT
  508.               iecou=0
  509.               inecou=0
  510.               CALL BETAXI(SIG0,NSTRSS,DSIGT,VAR0,XMAT,IVAL,NMATT,XCAR,
  511.      &                      SIGF,VARF,DEFP,MFR1,KERRE,iecou,inecou)
  512.               IF(KERRE.GT.200) THEN
  513.                  KERR1=1
  514.               END IF
  515. c
  516.             ELSE IF ((INPLAS .EQ. 39) .AND. (MFR .EQ. 27)) THEN
  517. c
  518. c      modele beton_uni pour les elements unidirectionels (barre ..)
  519. c
  520.               KERR1=0
  521.               CALL BARBET(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  522. c
  523.             ELSE IF ((INPLAS .EQ. 40) .AND. (MFR .EQ. 27)) THEN
  524. c
  525. c      modele acier_uni pour les elements unidirectionels (barre ..)
  526. c
  527.               KERR1=0
  528.               CALL BARSTE(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  529. c
  530.             ELSE IF ((INPLAS .EQ. 93) .AND. (MFR .EQ. 27)) THEN
  531. c
  532. c      modele ancrage_acier pour les elements unidirectionels (barre ..)
  533. c
  534.               KERR1=0
  535.               CALL BARSTA(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  536. *
  537.             ELSE IF ((INPLAS .EQ. 78) .AND. (MFR .EQ. 27)) THEN
  538. c
  539. c      modele fragile_uni pour les elements unidirectionels (barre ..)
  540. c
  541.               KERR1=0
  542.               CALL BARFRA(XMAT,XCAR,DEPST,VAR0,SIGF,VARF,DEFP)
  543. *
  544.             ELSE IF ((INPLAS .EQ. 79) .AND. (MFR .EQ. 27)) THEN
  545. c
  546. c      modele beton_bael pour les elements unidirectionels (barre ..)
  547. c
  548.               KERR1=0
  549.               CALL BABAEL(XMAT,XCAR,DEPST,VAR0,SIGF,VARF,DEFP)
  550. c
  551.             ELSE IF ((INPLAS .EQ. 92) .AND. (MFR .EQ. 27)) THEN
  552. c
  553. c      modele ancrage_parfait pour les elements unidirectionels (barre ..)
  554. c
  555.               KERR1=0
  556.               CALL BARPAA(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  557. *
  558.             ELSE IF ((INPLAS .EQ. 80) .AND. (MFR .EQ. 27)) THEN
  559. c
  560. c      modele parfait_uni pour les elements unidirectionels (barre ..)
  561. c
  562.               KERR1=0
  563.               CALL BARPAR(XMAT,XCAR,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  564. *
  565.               IF(KERRE.NE.0) GOTO 99
  566. c
  567. c      modele acier_uni pour les materiau unidirectionel
  568. c
  569.             ELSE IF (INPLAS .EQ. 40 .AND. MATE.EQ.4) THEN
  570.               CALL UNIACI(WRK0,WRK1,NSTRSS,MFR1,KERRE)
  571. c
  572. c
  573. c     modele poutre en formulation section
  574. c
  575.             ELSE IF (INPLAS.EQ.41.AND.MFR.EQ.7) THEN
  576. *
  577.                CALL BIFLEX(WRK0,WRK1,NSTRSS,NVARI,NMATT,
  578.      1                                                  CMATE,KERRE)
  579. c
  580.             ELSE IF ( INPLAS .EQ. 50 ) THEN
  581. c
  582. c   cas du modele de zerilli armstrong
  583. c
  584. c   on recupere le pas de temps
  585. c
  586.                 CALL ACCTAB(IPOTAB,'MOT     ',IVALIN,XVALIN,
  587.      1                     'DT',LOGIN,IOBIN,
  588.      2                     'FLOTTANT',IVALRE,DT,CHARRE,LOGRE,IOBRE)
  589. c
  590.             IF (KERRE .EQ. 0) THEN
  591.               DO 1114 IC=1,ICARA
  592.                  WORK(IC)=XCAR(IC)
  593. 1114          continue
  594.               BID(1)=0.D00
  595.               BID(2)=0.D00
  596.               BID(3)=0.D00
  597.               mfr1=mfr
  598.               CALL ZERILI(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  599.      1        N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  600.      2        SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  601.      3        NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  602.      4        XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT   )
  603.             END IF
  604. c
  605. c     modele de steinberg cochran guinan
  606. c
  607.             ELSE IF (INPLAS.EQ.49) THEN
  608.                CALL STEINB(DEPST,NSTRSS,
  609.      1              MFR1,IB,IGAU,
  610.      4              DSIGT,NMATT,SIG0,VAR0,XMAT,XCAR,NVARI,
  611.      5              ICARA,SIGF,VARF,DEFP,TETA1,TETA2,KERRE)
  612.                   IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  613.                      KERR1=1
  614.                   END IF
  615. c
  616. c     modele hujeux
  617. c
  618.             ELSE IF (INPLAS.EQ.48) THEN
  619.               CALL HUJEUX(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NCOMAT,XCAR,
  620.      .                    SIGF,VARF,DEFP,PRECIS,MFR1,KERRE)
  621. c
  622. c     modele ottosen
  623. c
  624.             ELSE IF (INPLAS.EQ.42) THEN
  625.               MPTVAL=IVAMAT
  626.               CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,
  627.      &           NMATT,XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  628.      &           IB,IGAU)
  629. c
  630.             ELSE IF (INPLAS.EQ.47) THEN
  631. c
  632. c      modele de amadei-saeb pour les joints
  633. c
  634. C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi
  635.                MPTVAL=IVAMAT
  636.                IF (IFOUR.EQ.2) THEN
  637. c
  638. c --------------------joints 3d
  639. c
  640.                 CALL AMADE3(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  641.      &     DEPST,IFOURB,XMAT,NMATT,IVAL,SIGF,DEFP,VARF,KERRE)
  642.                ELSE
  643. c
  644. c --------------------joints 2d
  645. c
  646.                 CALL AMADE2(IB,IGAU,NSTRSS,SIG0,EPIN0,VAR0,NVARI,
  647.      &     DEPST,IFOURB,XMAT,NMATT,IVAL,SIGF,DEFP,VARF,KERRE)
  648.                ENDIF
  649. c
  650.             ELSE IF (INPLAS.EQ.52) THEN
  651. c
  652. c  modèle Preston-Tonks-Wallace
  653. c
  654. c   on recupere le pas de temps
  655. c
  656.                 CALL ACCTAB(IPOTAB,'MOT     ',IVALIN,XVALIN,
  657.      1                     'DT',LOGIN,IOBIN,
  658.      2                     'FLOTTANT',IVALRE,DT,CHARRE,LOGRE,IOBRE)
  659. c
  660.                CALL PRESTO(DEPST,NSTRSS,
  661.      1              MFR1,IB,IGAU,
  662.      4              DSIGT,NMATT,SIG0,VAR0,XMAT,XCAR,NVARI,
  663.      5              ICARA,SIGF,VARF,DEFP,TETA1,TETA2,KERRE,DT)
  664.                   IF(KERRE.NE.0) THEN
  665.                      KERR1=1
  666.                   END IF
  667. c
  668.             ELSE IF (INPLAS.EQ.54) THEN
  669. c
  670. c     modele BETOCYCL
  671. c
  672. C
  673. C     ON VERIFIE LES CONTRAINTES PLANES
  674. C
  675.               IF (IFOUR.EQ.-2)THEN
  676. C
  677. C     ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION
  678. C
  679.                 IPOS1=1
  680.                 CALL COTRAI(WRK0,WRK2,12,IPOS1,0, NPOINT,KERRE)
  681.                 NTRAT=NPOINT/2
  682.                 IPOS2=IPOS1+NPOINT
  683.                 CALL COTRAI(WRK0,WRK2,13,IPOS2,0, NPOINT,KERRE)
  684.                 NTRAC=NPOINT/2
  685.                 IF(KERRE.EQ.0) THEN
  686.                   CALL BETOCY(WRK0,WRK1,WRK2,NTRAT,NTRAC,KERRE)
  687.                 END IF
  688.               ELSE
  689.                 KERRE = 99
  690.               ENDIF
  691. *
  692.             ELSE IF (INPLAS.EQ.55) THEN
  693. C
  694. C    MODELE ROTATING CRACK
  695. C
  696. C     ON VERIFIE LES CONTRAINTES PLANES
  697. C
  698.               IF (IFOUR.EQ.-2)THEN
  699.                 IF(KERRE.EQ.0) THEN
  700.                   CALL ROTATJ (WRK0,WRK1,KERRE)
  701.                 END IF
  702.               ELSE
  703.                 KERRE = 99
  704.               ENDIF
  705. c
  706.             ELSE IF (INPLAS.EQ.56)THEN
  707. C
  708. C    MODELE JOINT_SOFT
  709. C
  710.  
  711. C     ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR
  712. C
  713. C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est
  714. C       6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  715. C       'ALFA' a la place 3 et 4 dans defmat.eso
  716. C
  717.               IPOS1=1
  718.               CALL COTRAI(WRK0,WRK2,8,IPOS1,1, NPOINT,KERRE)
  719.               NTRAC=NPOINT/2
  720.               IPOS2=IPOS1+NPOINT
  721.               CALL COTRAI(WRK0,WRK2,9,IPOS2,1, NPOINT,KERRE)
  722.               NTRAS=NPOINT/2
  723.               IPOS3=IPOS2+NPOINT
  724.               CALL COTRAI(WRK0,WRK2,10,IPOS3,1, NPOINT,KERRE)
  725.               NTRAT=NPOINT/2
  726. C
  727.               IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  728.                IF(KERRE.EQ.0) THEN
  729. C
  730.                  CALL SJONL2(SIG0,DEPST,VAR0,XMAT,
  731.      .                       TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS,
  732.      .                       TRAC(IPOS3),NTRAT,
  733.      .                       SIGF,VARF,DEFP,KERRE)
  734.                END IF
  735.               ELSEIF(IFOUR.EQ.2)THEN
  736.                IF(KERRE.EQ.0) THEN
  737. C
  738.                  CALL SJONL3(SIG0,DEPST,VAR0,XMAT,
  739.      .                       TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT,
  740.      .                       TRAC(IPOS3),NTRAC,
  741.      .                       SIGF,VARF,DEFP,KERRE)
  742.                END IF
  743. C
  744.               END IF
  745. C
  746. c
  747.             ELSE IF (INPLAS.EQ.119)THEN
  748. C
  749. C    MODELE JOINT_COAT
  750. C
  751. C     ON RECUPERE LA COURBE DE SHEAR
  752. C
  753. C Note: La courbe a maintenant l'indices 4 alors que c'est
  754. C       2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  755. C       'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...)
  756. C
  757.               IPOS1=1
  758.               CALL COTRAI(WRK0,WRK2,4,IPOS1,1, NPOINT,KERRE)
  759.               NTRAS=NPOINT/2
  760. C
  761.               IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  762.                IF(KERRE.EQ.0) THEN
  763. C
  764.                  CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS,
  765.      .                       SIGF,VARF,DEFP,KERRE)
  766.                END IF
  767.               ELSEIF(IFOUR.EQ.2)THEN
  768.                IF(KERRE.EQ.0) THEN
  769.                END IF
  770. C
  771.               END IF
  772.  
  773. C+PPm
  774. c
  775.             ELSE IF (INPLAS.EQ.126)THEN
  776. C
  777. C    MODELE MUR_SHEAR
  778. C    pour le moment, element de poutre
  779. C
  780.              IF(MFR.EQ.7)THEN
  781. C
  782. C     ON RECUPERE LES COURBES
  783. C
  784. C Note: Les courbes ont maintenant les indices 5 a 10 alors que
  785. C       c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a
  786. C       incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso
  787. C
  788.                IPOS1=1
  789.                CALL COTRAI(WRK0,WRK2, 5,IPOS1,0, NPOINT,KERRE)
  790.                NCURFP=NPOINT/2
  791.                IPOS2=IPOS1+NPOINT
  792.                CALL COTRAI(WRK0,WRK2, 6,IPOS2,0, NPOINT,KERRE)
  793.                NCURKP=NPOINT/2
  794.                IPOS3=IPOS2+NPOINT
  795.                CALL COTRAI(WRK0,WRK2, 7,IPOS3,0, NPOINT,KERRE)
  796.                NCURLP=NPOINT/2
  797.                IPOS4=IPOS3+NPOINT
  798.                CALL COTRAI(WRK0,WRK2, 8,IPOS4,0, NPOINT,KERRE)
  799.                NCURFM=NPOINT/2
  800.                IPOS5=IPOS4+NPOINT
  801.                CALL COTRAI(WRK0,WRK2, 9,IPOS5,0, NPOINT,KERRE)
  802.                NCURKM=NPOINT/2
  803.                IPOS6=IPOS5+NPOINT
  804.                CALL COTRAI(WRK0,WRK2,10,IPOS6,0, NPOINT,KERRE)
  805.                NCURLM=NPOINT/2
  806. C
  807.                IF(KERRE.EQ.0) THEN
  808.                  CALL   MSHETI(WRK0,WRK1,WRK2,
  809.      >                  NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  810.      >                  IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6 ,
  811.      >                  KERRE)
  812.                END IF
  813. C
  814.              END IF
  815. C+PPm
  816.  
  817.             ELSE IF (INPLAS.EQ.91)THEN
  818. C
  819. C    MODELE ANCRAGE_ELIGEHAUSEN
  820. C
  821.               IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  822. C
  823.                  CALL ANCREL(SIG0,DEPST,VAR0,XMAT,
  824.      .                       SIGF,VARF,DEFP,KERRE)
  825.                END IF
  826. c
  827.             ELSE IF (INPLAS.EQ.57)THEN
  828. C
  829. C     MODELE BILI_MOMY
  830. C
  831.               KERRE=0
  832.               CALL BILIPO(SIG0,DEPST,VAR0,XMAT,XCAR,SIGF,VARF,DEFP)
  833. c
  834.             ELSE IF (INPLAS.EQ.58)THEN
  835. C
  836. C     MODELE BILI_EFFZ
  837. C
  838.               KERRE=0
  839.               CALL BILIFO(SIG0,DEPST,VAR0,XMAT,XCAR,SIGF,VARF,DEFP)
  840. c
  841.             ELSE IF (INPLAS.EQ.59)THEN
  842. C
  843. C     MODELE TAKEMO_MOMY
  844. C
  845. C     ON RECUPERE LES COURBES MOMENT-COURBURE
  846. C
  847.                CALL COTRAD(WRK0,WRK2,NCOURB,KERRE)
  848.                IF(KERRE.EQ.0) THEN
  849. C
  850.                  IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  851.                    CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  852.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  853.                  ELSE
  854.                    CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  855.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  856.                  ENDIF
  857.                END IF
  858. c
  859.             ELSE IF (INPLAS.EQ.60)THEN
  860. C
  861. C     MODELE TAKEMO_EFFZ
  862. C
  863. C
  864. C     ON RECUPERE LES COURBES MOMENT-COURBURE
  865. C
  866.                CALL COTRAD(WRK0,WRK2,NCOURB,KERRE)
  867.                IF(KERRE.EQ.0) THEN
  868. C
  869.                  IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  870.                    CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  871.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  872.                  ELSE
  873.                    CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,XCAR,
  874.      &                               TRAC,NCOURB,SIGF,VARF,DEFP,KERRE)
  875.                  ENDIF
  876. C
  877.                END IF
  878. c
  879.             ELSE
  880.                KERRE=99
  881.             ENDIF
  882. *
  883. *   Erreurs
  884. *      - problèmes de convergence
  885. *
  886.         CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  887. *
  888. *      - autres problèmes
  889. *
  890.         CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, KERR1,KERRE)
  891.  
  892.         IF (KERRE.NE.0) GOTO 99
  893. c
  894. c     remplissage du segment contenant les contraintes a la fin
  895. *     ( rearrangement pour milieu poreux ),
  896. c     les variables internes finales
  897. c     et les increments de deformations plastiques
  898. c
  899.       CALL DEFSIG(MFR,NDEF,
  900.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  901.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  902.      .     CMATE,MATE,MELE,KERRER)
  903.       IF (KERRER.NE.0) GOTO 1000
  904. c
  905. c    fin de la boucle sur les points de gauss
  906. c
  907. 1100     continue
  908. c
  909. c    special poutres et tuyaux  sauf timoschenko
  910. c
  911.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  912. c
  913. c     fin de la boucle sur les elements
  914. c
  915. 1000  continue
  916. *
  917. *  FIN: modèles visqueux, on stocke le pas de temps
  918. *  optimal en indice 'dtopti'
  919. *
  920.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  921.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  922.  
  923. * Fin normale ou erreur : menage des segments de travail
  924.  99   CONTINUE
  925.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  926.       IF (WRK4 .NE. 0) SEGSUP WRK4
  927.       MINTE2 = IPTR1
  928.       IF (MINTE2.NE.0) SEGSUP,MINTE2
  929.       IF (WRK22.NE.0) SEGSUP,WRK22
  930.       IF (WRK8.NE.0) SEGSUP WRK8
  931.  
  932.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  933.         SEGDES MELVA3,MELVA4,MELVA5
  934.         SEGDES MCHAM3,MCHAM4,MCHAM5
  935.       ENDIF
  936.  
  937.       RETURN
  938.       END
  939.  
  940.  
  941.  

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