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/02/21    21:16:06     12166          
  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 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.       REAL*8 LCAR
  202.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  203.       LOGICAL LUNI1,LUNI2
  204.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  205. *
  206.       CHARACTER*72 CHARRE
  207.       CHARACTER*8  CMATE
  208. c
  209. *
  210. *   mise à disposition des temperatures tini tfin tref
  211. *   aux points de gauss
  212. *
  213.          TETA1=-1.E35
  214.          TETA2=-1.E35
  215.          TETREF=-1.E35
  216.          TREFA=-1.E35
  217.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  218.             MCHAM3=IPH1
  219.             MCHAM4=IPH2
  220.             MCHAM5=IPH3
  221.             SEGACT MCHAM3
  222.             SEGACT MCHAM4
  223.             SEGACT MCHAM5
  224.             MELVA3=MCHAM3.IELVAL(1)
  225.             MELVA4=MCHAM4.IELVAL(1)
  226.             MELVA5=MCHAM5.IELVAL(1)
  227.             SEGACT MELVA3
  228.             SEGACT MELVA4
  229.             SEGACT MELVA5
  230.          ENDIF
  231. ****************************
  232. *    SPECIAL SUCCION
  233. *
  234.          SUCC1=-1.E35
  235.          SUCC2=-1.E35
  236.          IF (ITHHER.EQ.3) THEN
  237.             MCHAM3=IPH1
  238.             MCHAM4=IPH2
  239.             SEGACT MCHAM3
  240.             SEGACT MCHAM4
  241.             MELVA3=MCHAM3.IELVAL(1)
  242.             MELVA4=MCHAM4.IELVAL(1)
  243.             SEGACT MELVA3
  244.             SEGACT MELVA4
  245.          ENDIF
  246. ****************************
  247. c
  248. c   Initialisations de variables
  249. c---------------------------------
  250. c      - mise à zéro des variables du commun NECOU si besoin
  251. c      - modèles viscoplastiques:
  252. c                  . on récupère le pas de temps
  253. c                  . on récupère le nombre maximal de sous-pas
  254. c                  . on met IND=1
  255. c      - initialisation des dimensions des tableaux des segments
  256. c   Sorties: en plus du commun NECOU, on range les autres données
  257. c   initialisées dans les COMMON IECOU et XECOU
  258. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  259. c   argument de DEFINI
  260. c
  261.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  262.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  263.      .           IPMAIL,IVAMAT,
  264.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  265.      .           LUNI1,LUNI2,LW,KERRE)
  266.       IF (KERRE.EQ.999) RETURN
  267. c
  268. c  Initialisations des segments de travail
  269. c
  270. c
  271.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  272.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  273.      1     .OR.MFR.EQ.33)) THEN
  274.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  275.         MINTE2=IPTR1
  276.         SEGACT MINTE2
  277.         SEGINI WRK22
  278.       ENDIF
  279. c
  280.       IF (LOGVIS) SEGINI WRK8
  281.       SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  282.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN
  283.          SEGINI WRK4
  284.       ENDIF
  285. c
  286.       SEGINI WTRAV
  287. *
  288. *
  289. *       boucle sur les elements
  290. *
  291.       DO 1000 IB=1,NBELEM
  292. *
  293. *  Matériaux orthotropes, anisotropes et unidirectionnels
  294. *  en formulation massive:
  295. *     - on cherche  les coordonnees des noeuds de l element ib
  296. *     - calcul des axes locaux
  297. *  Cas particulier de l'ACIER_UNI
  298. *
  299.       CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  300.      .     MELEME,WRK4,WRK22,WTRAV)
  301. *
  302.       IF(INPLAS.EQ.66) THEN
  303.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  304.       ENDIF
  305. *
  306. *     CALCUL DE LA LONGUEUR CARACTERISTIQUE DE L'éLéMENT COURANT
  307. *     POUR MODèLE  BETON URGC INSA
  308. *
  309.  
  310.       IF(INPLAS.GE.99.AND.INPLAS.LE.101) THEN
  311.           CALL LONGCA(IPMAIL,IB,LCAR)
  312.       ENDIF
  313.  
  314. *
  315. *       boucle sur les points de gauss
  316. *
  317.          DO 1100 IGAU=1,NBPTEL
  318. *
  319. *  -recuperation de valmat et de valcar
  320. *  -on recupere les contraintes initiales
  321. *  -on recupere les variables internes
  322. *  -on recupere les deformations inelastiques initiales si besoin
  323. *  -on recupere les increments de deformations totales
  324. *  -on cherche la section de l'element ib
  325. *  -prise en compte de l'epaisseur et de l'excentrement
  326. *  dans le cas des coques minces avec ou sans cisaillement
  327. *  transverse
  328. *
  329.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  330.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  331.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  332.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  333. *
  334. *     on recupere les constantes du materiau
  335. *     calcul des contraintes effectives en milieu poreux
  336. *
  337.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  338.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  339.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  340.      .        BID,BID2,KERR0)
  341.       IF (KERR0.EQ.99) THEN
  342.          KERRE=99
  343.          GOTO 1000
  344.       ELSE IF (KERR0.EQ.10) THEN
  345.          GOTO 1000
  346.       ENDIF
  347. *
  348. * >>>>>>>>>>   fin du traitement du materiau
  349. *
  350. *        on recupere les caracteristiques geometriques
  351. *
  352.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  353.      .           WRK1)
  354. *
  355. *
  356. *          quelques impressions si iimpi = 99
  357. *
  358. *      IF(IIMPI.EQ.99) THEN
  359. *         WRITE(IOIMP,66770) IB,IGAU
  360. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  361. *         WRITE(IOIMP,66771) MATE,INPLAS,NMATT,NVARI
  362. *66771    format('0  mate=',i4,' inplas=',i4,' nmatt=',i4,' nvari=',i4/)
  363. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  364. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  365. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  366. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  367. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  368. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  369. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  370. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  371. *         IF(IVACAR.NE.0)THEN
  372. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  373. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  374. *         ENDIF
  375. *      ENDIF
  376. *
  377. *   mise à disposition des temperatures tini tfin tref
  378. *   aux points de gauss
  379. *
  380.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  381.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  382.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  383.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  384.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  385.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  386.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  387.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  388.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  389.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  390.          ENDIF
  391. ****************************
  392. *    SPECIAL SUCCION
  393. *
  394.          IF (ITHHER.EQ.3) THEN
  395.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  396.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  397.             SUCC1=MELVA3.VELCHE(IGMN,IBMN)
  398.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  399.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  400.             SUCC2=MELVA4.VELCHE(IGMN,IBMN)
  401.          ENDIF
  402. ****************************
  403. *
  404. *---------------------------------------------------------------------
  405. *
  406. *                  ecoulement selon les modeles
  407. *
  408. *---------------------------------------------------------------------
  409. *
  410.         MPTVAL=IVAMAT
  411.         IF (INPLAS.EQ.66)  THEN
  412. C
  413. C
  414. C  modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES,
  415. C               DEFORMATION PLANES ET AXISYMETRIE
  416. C
  417.              iwrk12=0
  418.              CALL BEINSA(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,NMATT,
  419.      1        SIGF,VARF,KERRE,MELE,IFOURB,NVARI,XCAR,NCARR,MFR,
  420.      2        EPIN0,EPINF,DT,XE,NBNN,CMATE,IB,IGAU,iwrk12)
  421. *
  422. *
  423.       ELSEIF (INPLAS.EQ.67) THEN
  424. C
  425. C  modele ECROUIS_INSA  (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE)
  426. C
  427.        MVEL1= nint(XMAT(NMATR))
  428.        CALL COTROR(WRK0,WRK2,NCOURB,MVEL1,KERRE)
  429.        LT1=NCOURB*2
  430.        CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,
  431.      1         TRAC,LT1,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOURB)
  432. *
  433. *
  434.           ELSEIF (INPLAS.EQ.68) THEN
  435. C
  436. C modele  PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE)
  437. C
  438.        NCOURB=3
  439.        KERRE = 0
  440.        TRAC(1)=0.D0
  441.        TRAC(2)=0.D0
  442.        TRAC(3)=XMAT(NMATR)
  443.        TRAC(4)=XMAT(NMATR)/XMAT(1)
  444.        TRAC(5)=XMAT(NMATR)
  445.        TRAC(6)=1.D0
  446.        IF(XMAT(NMATR).EQ.0.D0) KERRE = 33
  447.        LT1=NCOURB*2
  448.               CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,
  449.      1         TRAC,LT1,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOURB)
  450. C
  451.           ELSEIF (INPLAS.EQ.69) THEN
  452. C
  453. C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO
  454. C
  455. ****************************
  456. *    SPECIAL SUCCION
  457. *
  458.           nnecou=0
  459.           CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,
  460.      1         XMAT,SIG0,VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,
  461.      2         SUCC1,SUCC2,NNECOU)
  462.                   IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  463.                      KERR1=1
  464.                   END IF
  465. C
  466.           ELSEIF (INPLAS.EQ.71) THEN
  467. C
  468. C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD
  469. C
  470.           inecou=0
  471.           CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,
  472.      1         XMAT,SIG0,VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,
  473.      2         SUCC1,SUCC2,inecou)
  474.                   IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  475.                      KERR1=1
  476.                   END IF
  477. ****************************
  478. C
  479.           ELSEIF (INPLAS.EQ.72) THEN
  480. C
  481. C         MODELE INFILL_UNI
  482. C
  483.               IF (MFR.EQ.27) THEN
  484. C
  485. C     ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  486. C
  487.                 CALL COTRAI(WRK0,WRK2,12,1,0, NPOINT,KERRE)
  488.                 NCOURB=NPOINT/2
  489.                 IF(KERRE.EQ.0) THEN
  490.                    CALL INFILL(WRK0,WRK1,WRK2,NCOURB,KERRE)
  491.                 END IF
  492.               ELSE
  493.                  KERRE = 99
  494.               ENDIF
  495. C
  496.           ELSE IF (INPLAS.EQ.73)THEN
  497. C
  498. C         MODELE ETAGE
  499. C         pour le moment, element de barre
  500. *
  501.               IF (MFR.EQ.7) THEN
  502. C
  503. C     ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  504. C
  505.                 IPOS1=1
  506.                 CALL COTRAI(WRK0,WRK2,12,IPOS1,0, NPOINT,KERRE)
  507.                 NTRAP=NPOINT/2
  508.                 IPOS2=IPOS1+NPOINT
  509.                 CALL COTRAI(WRK0,WRK2,13,IPOS2,0, NPOINT,KERRE)
  510.                 NTRAN=NPOINT/2
  511.                 IF(KERRE.EQ.0) THEN
  512.                    CALL ETAGE(WRK0,WRK1,WRK2,NTRAP,NTRAN,KERRE)
  513.                 END IF
  514.               ELSE
  515.                  KERRE = 99
  516.               ENDIF
  517. C
  518.         ELSEIF (INPLAS.EQ.99)  THEN
  519.  
  520. C
  521. C
  522. C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  523. C               DEFORMATION PLANES ET AXISYMETRIE
  524. C
  525.              CALL URGCST(WRK0,WRK1,WRK4,NSTRSS,NMATT,
  526.      1        KERRE,MELE,IFOURB,NCARR,MFR,
  527.      2        DT,TEMP0,CMATE,IB,IGAU,LCAR,0)
  528. c
  529.         ELSEIF (INPLAS.EQ.101)  THEN
  530. C
  531. C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  532. C               DEFORMATION PLANES ET AXISYMETRIE
  533. C
  534.              CALL URGCST(WRK0,WRK1,WRK4,NSTRSS,NMATT,
  535.      1        KERRE,MELE,IFOURB,NCARR,MFR,
  536.      2        DT,TEMP0,CMATE,IB,IGAU,LCAR,2)
  537. *
  538. C
  539.           ELSE
  540.              KERRE=99
  541.           ENDIF
  542. *
  543. *   Erreurs
  544. *      - problèmes de convergence
  545. *
  546.       CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  547. *
  548. *      - autres problèmes
  549. *
  550.  1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  551.      .           KERR1,KERRE)
  552.       IF(MFR.EQ.49.OR.INPLAS.EQ.66) THEN
  553.         KERR1=0
  554.         KERRE=0
  555.         LOGSUC=.TRUE.
  556.       ENDIF
  557. *
  558. *
  559.  1998 IF(KERRE.NE.0) THEN
  560.              IF (LOGVIS) SEGSUP WRK8
  561.             SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  562.             IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN
  563.               SEGSUP WRK4
  564.             ENDIF
  565.             IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  566.      1        CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  567.      1       .OR.MFR.EQ.33)) THEN
  568.               SEGDES MINTE2
  569.               SEGSUP WRK22
  570.             ENDIF
  571.             IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  572.                SEGDES MELVA3
  573.                SEGDES MELVA4
  574.                SEGDES MELVA5
  575.                SEGDES MCHAM3
  576.                SEGDES MCHAM4
  577.                SEGDES MCHAM5
  578.             ENDIF
  579. ****************************
  580. *    SPECIAL SUCCION
  581. *
  582.             IF (ITHHER.EQ.3) THEN
  583.                SEGDES MELVA3
  584.                SEGDES MELVA4
  585.                SEGDES MCHAM3
  586.                SEGDES MCHAM4
  587.             ENDIF
  588. ****************************
  589.             RETURN
  590.       ENDIF
  591. c
  592. c     remplissage du segment contenant les contraintes a la fin
  593. *     ( rearrangement pour milieu poreux ),
  594. c     les variables internes finales
  595. c     et les increments de deformations plastiques
  596. c
  597.       CALL DEFSIG(MFR,NDEF,
  598.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  599.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  600.      .     CMATE,MATE,MELE,KERRER)
  601.       IF (KERRER.NE.0) GOTO 1000
  602. c
  603. c    fin de la boucle sur les points de gauss
  604. c
  605. 1100     continue
  606. c
  607. c    special poutres et tuyaux  sauf timoschenko
  608. c
  609.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  610. c
  611. c     fin de la boucle sur les elements
  612. c
  613. 1000  continue
  614. *
  615. *  FIN: modèles visqueux, on stocke le pas de temps
  616. *  optimal en indice 'dtopti'
  617. *
  618.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  619.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  620.       IF (LOGVIS) SEGSUP WRK8
  621. *
  622.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  623.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN
  624.          SEGSUP WRK4
  625.       ENDIF
  626.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  627.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  628.      1     .OR.MFR.EQ.33)) THEN
  629.         SEGDES MINTE2
  630.         SEGSUP WRK22
  631.       ENDIF
  632. *
  633.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  634.             SEGDES MELVA3
  635.             SEGDES MELVA4
  636.             SEGDES MELVA5
  637.             SEGDES MCHAM3
  638.             SEGDES MCHAM4
  639.             SEGDES MCHAM5
  640.       ENDIF
  641. ****************************
  642. *    SPECIAL SUCCION
  643. *
  644.       IF (ITHHER.EQ.3) THEN
  645.             SEGDES MELVA3
  646.             SEGDES MELVA4
  647.             SEGDES MCHAM3
  648.             SEGDES MCHAM4
  649.       ENDIF
  650. ****************************
  651. *
  652.       RETURN
  653.       END
  654.  
  655.  
  656.  

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