Télécharger la plaquette Cast3M


fr en

Télécharger ecou50.eso

Retour à la liste

Numérotation des lignes : 

ecou50

  1. C ECOU50    SOURCE    OF166741  25/11/04    21:15:50     12349          
  2.       SUBROUTINE ECOU50(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: -PLASTIQUE_ENDOM(MAGEABLE)
  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.       SEGMENT WRK0
  122.        REAL*8 XMAT(NCXMAT)
  123.       ENDSEGMENT
  124. *
  125.       SEGMENT WR00
  126.        CHARACTER*16 TYMAT(NCXMAT)
  127.        REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  128.       ENDSEGMENT
  129. *
  130.       SEGMENT WRK1
  131.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  132.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  133.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  134.       ENDSEGMENT
  135. *
  136.       SEGMENT WRK2
  137.         REAL*8 TRAC(LTRAC)
  138.       ENDSEGMENT
  139. *
  140.       SEGMENT ENDO0
  141.         REAL*8 ENDO(LENDO),RAPP(LENDO)
  142.       ENDSEGMENT
  143. *
  144.       SEGMENT WRK22
  145.         REAL*8 XXE(3,NBNN)
  146.       ENDSEGMENT
  147. *
  148.       SEGMENT WRK3
  149.         REAL*8 WORK(LW),WORK2(LW2)
  150.       ENDSEGMENT
  151. *
  152.       SEGMENT WRK4
  153.         REAL*8 XE(3,NBBB)
  154.       ENDSEGMENT
  155. *
  156.       SEGMENT WRK5
  157.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  158.       ENDSEGMENT
  159. *
  160.       SEGMENT WRK6
  161.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  162.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  163.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  164.       ENDSEGMENT
  165. *
  166.       SEGMENT WRK7
  167.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  168.       ENDSEGMENT
  169. *
  170.       SEGMENT WRK8
  171.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  172.       ENDSEGMENT
  173. *
  174.       SEGMENT WRK9
  175.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  176.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  177.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  178.         REAL*8 SIGY(NSIGY)
  179.         INTEGER NKX(NNKX)
  180.       ENDSEGMENT
  181. *
  182.       SEGMENT WR10
  183.         INTEGER IABLO1(NTABO1)
  184.         REAL*8  TABLO2(NTABO2)
  185.       ENDSEGMENT
  186. *
  187.       SEGMENT WR11
  188.         INTEGER IABLO3(NTABO3)
  189.         REAL*8  TABLO4(NTABO4)
  190.       ENDSEGMENT
  191. *
  192.       SEGMENT WTRAV
  193.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  194.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  195.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  196.         REAL*8 XLOC(3,3),XGLOB(3,3)
  197.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  198.       ENDSEGMENT
  199. *
  200.       SEGMENT WPOUT
  201.          REAL*8  X(2),Y(2),Z(2)
  202.       ENDSEGMENT
  203. *
  204.       SEGMENT DRA0
  205.         REAL*8 AAA(LDRA0)
  206.       ENDSEGMENT
  207.  
  208.       LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  209.       LOGICAL LUNI1,LUNI2
  210.       DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  211.  
  212.       CHARACTER*72 CHARRE
  213.       CHARACTER*8  CMATE
  214. *
  215. *   mise à disposition des temperatures tini tfin tref
  216. *   aux points de gauss
  217. *
  218.          TETA1=-1.E35
  219.          TETA2=-1.E35
  220.          TETREF=-1.E35
  221.          TREFA=-1.E35
  222.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  223.             MCHAM3=IPH1
  224.             MCHAM4=IPH2
  225.             MCHAM5=IPH3
  226.             SEGACT MCHAM3,MCHAM4,MCHAM5
  227.             MELVA3=MCHAM3.IELVAL(1)
  228.             MELVA4=MCHAM4.IELVAL(1)
  229.             MELVA5=MCHAM5.IELVAL(1)
  230.             SEGACT MELVA3,MELVA4,MELVA5
  231.          ENDIF
  232.  
  233. c   Initialisations de variables
  234. c---------------------------------
  235. c      - mise à zéro des variables du commun NECOU si besoin
  236. c      - modèles viscoplastiques:
  237. c                  . on récupère le pas de temps
  238. c                  . on récupère le nombre maximal de sous-pas
  239. c                  . on met IND=1
  240. c      - initialisation des dimensions des tableaux des segments
  241. c   Sorties: en plus du commun NECOU, on range les autres données
  242. c   initialisées dans les COMMON IECOU et XECOU
  243. c   Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  244. c   argument de DEFINI
  245. c
  246.       CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  247.      .           ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  248.      .           IPMAIL,IVAMAT,
  249.      .           ITHHER,NUMAT,NUCAR,LOGVIS,
  250.      .           LUNI1,LUNI2,LW,KERRE)
  251.       IF (KERRE.EQ.999) RETURN
  252. c
  253. c  Initialisations des segments de travail
  254. c
  255.       WRK22 = 0
  256.       IPTR1 = 0
  257.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  258.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  259.      1     .OR.MFR.EQ.33)) THEN
  260.         CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  261.         IF (IRT1.NE.1) THEN
  262.           CALL ERREUR(21)
  263.           RETURN
  264.         ENDIF
  265.         MINTE2=IPTR1
  266. c*        SEGACT,MINTE2 <- nouveau segment cree dans RESHPT et actif
  267.         SEGINI WRK22
  268.       ENDIF
  269.  
  270.       WRK8 = 0
  271.       IF (LOGVIS) SEGINI WRK8
  272.  
  273.       SEGINI,WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  274.       SEGINI WTRAV
  275.  
  276.       ENDO0 = 0
  277.       IF (INPLAS.EQ.51) SEGINI ENDO0
  278.  
  279.       WRK4 = 0
  280.       IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  281.          SEGINI WRK4
  282.       ENDIF
  283. c
  284.       IF (INPLAS.EQ.75) THEN
  285.          LDRA0=951
  286.          SEGINI DRA0
  287.       ENDIF
  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. *       boucle sur les points de gauss
  303. *
  304.          DO 1100 IGAU=1,NBPTEL
  305. *
  306. *  -recuperation de valmat et de valcar
  307. *  -on recupere les contraintes initiales
  308. *  -on recupere les variables internes
  309. *  -on recupere les deformations inelastiques initiales si besoin
  310. *  -on recupere les increments de deformations totales
  311. *  -on cherche la section de l'element ib
  312. *  -prise en compte de l'epaisseur et de l'excentrement
  313. *  dans le cas des coques minces avec ou sans cisaillement
  314. *  transverse
  315. *
  316.       CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  317.      .     IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  318.      .     IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  319.      .     WTRAV,WRK1,WRK5,SECT,EPAIST)
  320. *
  321. *     on recupere les constantes du materiau
  322. *     calcul des contraintes effectives en milieu poreux
  323. *
  324.       CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  325.      .        IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  326.      .        WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  327.      .        BID,BID2,KERR0)
  328.       IF (KERR0.EQ.99) THEN
  329.          KERRE=99
  330.          GOTO 1000
  331.       ELSE IF (KERR0.EQ.10) THEN
  332.          GOTO 1000
  333.       ENDIF
  334. *
  335. * >>>>>>>>>>   fin du traitement du materiau
  336. *
  337. *        on recupere les caracteristiques geometriques
  338. *
  339.       CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  340.      .           WRK1)
  341. *
  342. *          quelques impressions si iimpi = 99
  343. *
  344. *      IF(IIMPI.EQ.99) THEN
  345. *         WRITE(IOIMP,66770) IB,IGAU
  346. *66770    format(////////2x,'element  ',i6,2x,'point  ',i3//)
  347. *         WRITE(IOIMP,66771) MATE,INPLAS
  348. *66771    format('0  mate=',i4,2x,'inplas=',i4/)
  349. *         WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  350. *66772    format(2x,'  sig0 '/(6(1x,1pe12.5)))
  351. *         WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  352. *66773    format(2x,'  var0 '/(6(1x,1pe12.5)))
  353. *         WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  354. *66774    format(2x,'  depst '/(6(1x,1pe12.5)))
  355. *         WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  356. *66775    format(2x,'  xmat  '/(6(1x,1pe12.5)))
  357. *         IF(IVACAR.NE.0)THEN
  358. *            WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  359. *66776       format(2x,'  xcar  '/(6(1x,1pe12.5)))
  360. *         ENDIF
  361. *      ENDIF
  362. *
  363. *   mise à disposition des temperatures tini tfin tref
  364. *   aux points de gauss
  365. *
  366.          IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  367.             IBMN=MIN(IB,MELVA3.VELCHE(/2))
  368.             IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  369.             TETA1=MELVA3.VELCHE(IGMN,IBMN)
  370.             IBMN=MIN(IB,MELVA4.VELCHE(/2))
  371.             IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  372.             TETA2=MELVA4.VELCHE(IGMN,IBMN)
  373.             IBMN=MIN(IB,MELVA5.VELCHE(/2))
  374.             IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  375.             TETREF=MELVA5.VELCHE(IGMN,IBMN)
  376.          ENDIF
  377. *
  378. *---------------------------------------------------------------------
  379. *
  380. *                  ecoulement selon les modeles
  381. *
  382. *---------------------------------------------------------------------
  383. c
  384. c     modeles implantes dans ecoinc
  385. c
  386.                IF (INPLAS.EQ.51) THEN
  387. c
  388. c   cas de la plasticite isotrope ecrouissable avec un
  389. c   endommagement de type P/Y
  390. c
  391. c on recupere la courbe de traction et la courbe de début d'endommagement
  392. c
  393.                CALL COEND(WRK0,WRK2,ENDO0,NCOURB,NENDO,
  394.      1                    NRAPP,KERRE)
  395.                INPLS0 = 5
  396.                IF (VAR0(7).GE.1.D-10) THEN
  397.                  DO 110 I=1,NSTRS
  398.                     SIG0(I)=SIG0(I)/VAR0(7)
  399.  110             CONTINUE
  400.                ENDIF
  401. c
  402. c  calcul des contraintes plastiquement admissibles
  403. c
  404.                IF (KERRE .EQ. 0) THEN
  405.                   DO IC=1,ICARA
  406.                      WORK(IC)=XCAR(IC)
  407.                   ENDDO
  408.                   BID(1)=0.D00
  409.                   BID(2)=0.D00
  410.                   BID(3)=0.D00
  411.                   mfr1=mfr
  412.                   CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  413.      1            N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  414.      2            SIGF,VARF,DEFP,KERRE,     IB,IGAU,NSTRSS,EPAIST,MELE,
  415.      3            NPINT,NBPGAU,              SECT,LHOOK,TXR,XLOC,
  416.      4            XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLS0)
  417.                END IF
  418. c
  419. c  retour au modèle d'endommagement P/Y
  420. c
  421. c  calcul des contraintes endommagées
  422. c
  423.                CALL PSURY(ENDO,NENDO,NVARI,NSTRSS,MFR1,DEPST,XMAT,VAR0,
  424.      1              RAPP,NRAPP,
  425.      1              SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  426. c
  427.             ELSE IF (INPLAS.EQ.62) THEN
  428. c
  429. c  Modèle d'endommagement de Rousselier
  430. c   - on recupère la courbe de traction
  431. c
  432.               CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  433. c
  434. c   - appel au modèle
  435. C
  436.               IF(KERRE.EQ.0) THEN
  437.                   inecou=0
  438.                   CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,
  439.      1            DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  440.      2            SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  441.                   IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  442.                      KERR1=1
  443.                   ENDIF
  444.               ENDIF
  445. c
  446.             ELSE IF (INPLAS.EQ.64) THEN
  447. c
  448. c  Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  449. c   - on recupère la courbe de traction
  450. c
  451.        CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  452. c
  453. c   - appel au modèle
  454. c
  455.               IF(KERRE.EQ.0) THEN
  456.                   CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,
  457.      1            DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  458.      2            SIGF,VARF,DEFP,TRAC,KERRE,ncourb)
  459.                   IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  460.                      KERR1=1
  461.                   END IF
  462.               ENDIF
  463. c
  464.             ELSE IF (INPLAS.EQ.75) THEN
  465. c
  466. c  Modèle d'endommagement de Dragon
  467. c
  468.          CALL DRAGON(WRK0,WRK1,WRK5,DRA0,KERRE)
  469. c
  470.             ELSE
  471.                KERRE = 99
  472.             ENDIF
  473. *
  474. *   Erreurs
  475. *      - problèmes de convergence
  476. *
  477.         CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  478. *
  479. *      - autres problèmes
  480. *
  481.         CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU, KERR1,KERRE)
  482.  
  483.         IF (KERRE.NE.0) GOTO 99
  484.  
  485. c     remplissage du segment contenant les contraintes a la fin
  486. *     ( rearrangement pour milieu poreux ),
  487. c     les variables internes finales
  488. c     et les increments de deformations plastiques
  489. c
  490.       CALL DEFSIG(MFR,NDEF,
  491.      .     INPLAS,IND,WRK1,WRK5,WTRAV,
  492.      .     IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  493.      .     CMATE,MATE,MELE,KERRER)
  494.       IF (KERRER.NE.0) GOTO 1000
  495. c
  496. c    fin de la boucle sur les points de gauss
  497. c
  498. 1100     continue
  499. c
  500. c    special poutres et tuyaux  sauf timoschenko
  501. c
  502.       CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  503. c
  504. c     fin de la boucle sur les elements
  505. c
  506. 1000  continue
  507. c
  508. *  FIN: modèles visqueux, on stocke le pas de temps
  509. *  optimal en indice 'dtopti'
  510. *
  511.       CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  512.      .     TCAR,DTOPTI,IPOTAB,KERRE)
  513.  
  514. C- FIN Normale ou Erreur : Menage des segments de travail
  515.  99   CONTINUE
  516.       SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  517.  
  518.       IF (LOGVIS) SEGSUP WRK8
  519.  
  520.       IF (WRK4.NE.0) SEGSUP WRK4
  521.  
  522.       IF (INPLAS.EQ.51) SEGSUP ENDO0
  523.       IF (INPLAS.EQ.75) SEGSUP DRA0
  524.       IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  525.      1     CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  526.      1     .OR.MFR.EQ.33)) THEN
  527.         MINTE2 = IPTR1
  528. c*        SEGDES MINTE2
  529.         SEGSUP MINTE2
  530.         SEGSUP WRK22
  531.       ENDIF
  532.  
  533.       IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  534.         SEGDES MELVA3,MELVA4,MELVA5
  535.         SEGDES MCHAM3,MCHAM4,MCHAM5
  536.       ENDIF
  537.  
  538.       RETURN
  539.       END
  540.  
  541.  
  542.  

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