Download ecou25.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer