Télécharger coml7.eso

Retour à la liste

coml7
C COML7     SOURCE    OF166741  25/11/17    21:15:01     12402          
      SUBROUTINE COML7(iqmod,wrk52,wrk53,wrk54,IB,igau,
     & wrk2,mwrkxe,wrk3,wrk7,wrk8,wrk9,wrk91,iretou,
     & wr13,wr14,ecou,iecou,necou,xecou,ifus)
 
*-----------------------------------------------------------------------
* lois locales  en MECANIQUE et POREUX
*  decrites au point d integration
*-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC CCHAMP
 
-INC SMLREEL
-INC SMMODEL
-INC SMELEME
-INC SMINTE
-INC SMCOORD
 
* segment deroulant le mcheml
-INC DECHE
 
-INC TECOU
 
      SEGMENT WRK2
        REAL*8 TRAC(LTRAC)
      ENDSEGMENT
*
      SEGMENT WRK3
        REAL*8 WORK(LW),WORK2(LW2)
      ENDSEGMENT
*
      SEGMENT MWRKXE
        REAL*8 XE(3,NBNN)
      ENDSEGMENT
*
      SEGMENT ENDO0
        REAL*8 ENDO(LENDO),RAPP(LENDO)
      ENDSEGMENT
*
      SEGMENT WRK7
        REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
      ENDSEGMENT
*
      SEGMENT WRK8
        REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
        REAL*8 DDINVp(NSTRS,NSTRS)
      ENDSEGMENT
*
      SEGMENT WRK9
        REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
        REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
        REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
        REAL*8 SIGY(NSIGY)
        INTEGER NKX(NNKX)
      ENDSEGMENT
*
      SEGMENT WRK91
        REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
        REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
        REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
        REAL*8 SIGY1(NSIGY1)
      ENDSEGMENT
*
c mistral :
      SEGMENT WR13
        REAL*8 PDILT(NPDILT),PNBRE(NPNBRE),PCOHI(NPCOHI),PECOU(NPECOU)
        REAL*8 PEDIR(NPEDIR),PRVCE(NPRVCE),PECRX(NPECRX),PDVDI(NPDVDI)
        REAL*8 PCROI(NPCROI)
        REAL*8 PINCR(NPINCR)
      ENDSEGMENT
 
c  fluendo3D
      SEGMENT WR14
        INTEGER INLVIA(NBVIA)
      ENDSEGMENT
 
      REAL*8 CRIGI(12),CMASS(12),XCAR(1)
 
*      moterr(1:6) = 'COML7  '
*      moterr(7:15) = 'element '
*      interr(1) = ib
*      interr(2) = igau
*      call erreur(-329)
 
      imodel = iqmod
*---------------------------------------------------------------------
*                  ecoulement selon les modeles
*---------------------------------------------------------------------
c
      NBPGAU = NBGS
      NVARI  = NVART
      NSTRSL = iecou.NSTRSS
      JNPLAS = INPLAS
      JMFR   = iecou.MFRbi
 
C======================================================================
C                     MODELE ELASTIQUE LINEAIRE
C======================================================================
C     write(6,*) 'COML7 : IFUS =',IFUS
      IF (JNPLAS.EQ.0.OR.IFUS.EQ.1) THEN
* barres et poutres
        IF (JMFR.EQ.7.OR.JMFR.EQ.13) THEN
          IF (CMATE.EQ.'SECTION ') THEN
            IPM = int(xmat(1))
            IPC = int(xmat(2))
            MLREEL = NINT(XMAT(3))
            IF(MLREEL.EQ.0)THEN
              CALL FRIGIE(IPM,IPC,CRIGI,CMASS)
            ELSE
              SEGACT, MLREEL
              CALL BIFLX1(PROG(1),NSTRS,CRIGI)
              SEGDES, MLREEL
            ENDIF
          ENDIF
        ENDIF
c
        CALL CALSIG(DEPST,DDAUX,NSTRSL,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
     1              MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,NPINT,NBGMAT,
     2              NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,
     3              DDHOMU,CRIGI,DSIGT,IRTD)
 
        IF (IRTD.EQ.1) THEN
          DO 10 IC=1,NSTRSL
            SIGF(IC)=SIG0(IC)+DSIGT(IC)
 10       CONTINUE
 
          XVAR = 1.D0
          IF (IFUS.EQ.1) XVAR = 0.D0
 
          DO 20  IC=1,NVARI
            VARF(IC) = XVAR*VAR0(IC)
 20       CONTINUE
 
          IF (IFUS.EQ.1) THEN
            NDEIN = EPIN0(/1)
C     write(6,*) 'COML7 : NDEIN =',NDEIN
            DO 21  IC=1,NDEIN
              EPINF(IC) = EPIN0(IC)
              DEFP(IC)  = 0.D0
 21         CONTINUE
          ENDIF
 
        ELSE
          KERRE=69
        ENDIF
 
        RETURN
      ENDIF
 
*---------------------------------------------------------------------
* appel ccoin0 et ccoinc
* mfr1 <- MFR , nstrss <- nstrs , wrk52 <- wrk0
* CCOTRA <- COTRAC , xcarb <- XCAR
*---------------------------------------------------------------------
C
C           1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
      GOTO(301,300,303,304,305,300,307,300,300,300,300,312,300,300,315,
     $     300,317,300,319,320,321,322,323,324,325,300,300,300,300,300,
*           31
     $     300,300,300,300,300,300,300,300,300,300,300,300,343,344,345,
     $     300,300,300,300,350,351,300,353,300,300,300,300,300,300,300,
*           61
     $     361,300,363,300,300,300,300,300,300,370,300,300,300,300,300,
     $     376,377,300,300,300,300,382,300,384,385,386,387,300,300,390,
*           91
     $     300,300,300,394,395,300,300,300,300,400,401,402,403,300,405,
     $     300,407,300,300,300,411,412,413,300,300,300,300,300,300,420,
*          121
     $     421,422,300,300,300,300,300,300,300,430,300,300,300,300,300,
     $     436,437,438,439,300,300,300,300,300,300,300,300,300,300,300,
*          151
     $     300,300,300,300,300,300,300,300,300,300,300,300,300,300,440,
     $     300,300,300,300,300,300,300,300,300,300,300,300,300,300,440,
*          181                     <---Sellier-------> 192
     $     300,300,300,300,300,300,487,488,489,490,491,440,300,300,300
     $ ) JNPLAS
C
C======================================================================
  300 CONTINUE
      WRITE(IOIMP,*) ' ERREUR D AIGUILLAGE COML7 '
      CALL ERREUR(5)
      RETURN
C
C======================================================================
C             MODELES PLASTIQUES VIA CCOINC OU CCOIN0
C======================================================================
C     MODELE PLASTIQUE PARFAIT
 301  CONTINUE
      KERRE = 0
      IF (MATE.EQ.4.AND.(JMFR.EQ.1.OR.JMFR.EQ.31)
     &    .AND.IDIM.EQ.3) THEN
        r_z = XMAT(9)
      ELSE
        r_z = XMAT(5)
      ENDIF
      IF (r_z.LE.0.D0) KERRE = 33
      NCOURB = 2
      TRAC(1) = r_z
      TRAC(3) = r_z
      TRAC(2) = 0.D0
      TRAC(4) = 1.D9
      GO TO 800
C
C     -----------------------------------------------------------------
C     MODELE PLASTIQUE DRUCKER_PARFAIT
  303 CONTINUE
c
c    cas du modele de drucker-prager parfait
c    les donnees sont les limites en traction et en compression
c
      IMAPLA=5
      KERRE = 0
      DEN =  ABS(XMAT(6)) + XMAT(5)
      IF (DEN.EQ.0.D0) THEN
        KERRE=48
      ELSE
        XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
        XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
        XMAT(6) = 1.D0
        XMAT(8)=XMAT(5)
        XMAT(9)=XMAT(6)
        XMAT(10)=XMAT(5)
        XMAT(11)=XMAT(6)
        XMAT(12)=XMAT(7)
        XMAT(13)=0.D0
c
c       petits tests sur les donnees
        IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
     &     XMAT(5)*1.01/(XMAT(6)+1.D-20)
     &         .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
          KERRE = 48
        ENDIF
      ENDIF
      GO TO 800
C
C     -----------------------------------------------------------------
C     MODELE PLASTIQUE CINEMATIQUE
  304 CONTINUE
c
c    cas de la plasticite cinematique bilineaire
c
      IF(XMAT(5).EQ.0.D0) THEN
        KERRE=33
      ELSE
        ICINE=1
        NCOURB=2
        TRAC(1)=XMAT(5)
        TRAC(2)=0.D0
        TRAC(4)=1.D9
        TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4)
      ENDIF
      GOTO 800
C
C     -----------------------------------------------------------------
C     MODELES PLASTIQUE ISOTROPE ET ELASTIQUE NON LINEAIRE
  305 CONTINUE
  387 CONTINUE
c
c   cas de la plasticite isotrope ecrouissable
c
c  on recupere la courbe de traction
c
      nccor=ncourb
      CALL CCOTRA(WRK52,WRK2,NCcor,WRK53)
      ncourb=nccor
      GO TO 800
C
C     -----------------------------------------------------------------
C     MODELE PLASTIQUE CHABOCHE1
  307 CONTINUE
      KERRE = 0
      ICINE = 1
      IMAPLA= 4
      GO TO 800
C
C     -----------------------------------------------------------------
C     MODELE PLASTIQUE CHABOCHE2
  312 CONTINUE
      KERRE = 0
      ICINE = 1
      IMAPLA= 4
      GO TO 800
C
C     -----------------------------------------------------------------
C     MODELE PLASTIQUE DRUCKER_PRAGER
  315 CONTINUE
      IMAPLA=5
c
c     petits tests sur les donnees
c
      IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
     1   XMAT(5)*1.01/(XMAT(6)+1.D-20)
     2       .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
        KERRE = 48
      ELSE
        KERRE = 0
c
c       permutations pour ecoinc
c
        DO 30 I=5,7
          WW=XMAT(I)
          XMAT(I)=XMAT(I+5)
          XMAT(I+5)=WW
 30     CONTINUE
      ENDIF
      GO TO 800
C
C     -----------------------------------------------------------------
C     MODELE PLASTIQUE_ENDOM PSURY
  351 CONTINUE
C
      SEGINI ENDO0
c   cas de la plasticite isotrope ecrouissable avec un
c   endommagement de type P/Y
c
c on recupere la courbe de traction et la courbe de début d'endommagement
      nccor=ncourb
      CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP)
      ncourb=nccor
      IF (VAR0(7).GE.1.D-10) THEN
        DO 110 I=1,NSTRS
          SIG0(I)=SIG0(I)/VAR0(7)
110     CONTINUE
      ENDIF
C
C     -----------------------------------------------------------------
 800  CONTINUE
      IF (KERRE .NE. 0) RETURN
**    write(6,*) 'coml7 icara en 373',icara
      DO 40 IC=1,ICARA
        WORK(IC)=XCARB(IC)
40    CONTINUE
**    write(6,*) 'work',(work(ic),ic=1,icara)
      BID(1)=0.D00
      BID(2)=0.D00
      BID(3)=0.D00
 
      IF ((JNPLAS .EQ. 1 .OR.JNPLAS .EQ. 4  .OR.
     &     JNPLAS .EQ. 5 .OR.JNPLAS .EQ. 7  .OR.
     &     JNPLAS .EQ. 12.OR.JNPLAS .EQ. 87 ) .AND.
     &     (JMFR .EQ. 1 .OR. JMFR .EQ. 3 .OR.
     &      JMFR .EQ. 5 .OR. JMFR .EQ. 7 .OR.
     &      JMFR .EQ. 9 .OR. JMFR .EQ. 31)  .AND.
     &     (CMATE.NE.'UNIDIREC')) THEN
c
        nccor=ncourb
        iforb=ifourb
 
        CALL CCOIN0(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
     &                  NBPGAU,NCcor,IFORB,iecou)
        ncourb=nccor
        ifourb=iforb
c
      ELSE
c
        CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
     &                  NBPGAU,ecou,necou,iecou)
C
C     Modele d'endommagement P/Y : calcul des contraintes endommagees
        IF (JNPLAS.EQ.51) THEN
          CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP,
     &               NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
          SEGSUP ENDO0
        ENDIF
C
      ENDIF
C
      RETURN
C
C======================================================================
C     MODELE PLASTIQUE ZERILI (Modele de Zerili-Armstrong)
C======================================================================
  350 CONTINUE
c     on recupere le pas de temps dt : voir comval
c     kich : fixe dt = 0. pour plasticite
      dtk1 = dt
      dt = 0.d0
c
      IF (KERRE .EQ. 0) THEN
**    write(6,*) 'coml7 icara en 424',icara
        DO 1124 IC=1,ICARA
          WORK(IC)=xcarb(IC)
1124    CONTINUE
        BID(1)=0.D00
        BID(2)=0.D00
        BID(3)=0.D00
        CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
     &              NBPGAU,necou,ecou,iecou,xecou)
      ENDIF
      dt = dtk1
      RETURN
C
C======================================================================
C     MODELES PLASTIQUE INPLAS 111, 112 et 113
C======================================================================
  411 CONTINUE
  412 CONTINUE
  413 CONTINUE
C     Calcula incremento de tensiones trial, DSIGT
      call CALSIG(DEPST,DDAUX,NSTRSL,CMATE,VALMAT,VALCAR,
     .                   N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,
     .               NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
     .               XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
      nescri   =0
      nues     =6
      nitmax   =25
      precis   =1.E-10
C
C     MODELE PLASTIQUE MRS_LADE
      IF (JNPLAS.eq.111) THEN
C       mrs-lade requiere siempre derivacion numerica
        nnumer=3
        deltax=2.D0**(int(log10(1.D-6)/log10(2.D0)))
        call eco_MRSMAC(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
     .                  NSTRSL,XMAT,KERRE,PRECIS,NITMAX,nescri,
     .                  nues,nnumer,deltax,kdummy)
C
C     MODELE PLASTIQUE J2
      ELSE IF (JNPLAS.eq.112) THEN
        call eco_j2(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
     .              NSTRSL,XMAT,KERRE,PRECIS,NITMAX,nescri,
     .              nues,kdummy)
C
C     MODELE PLASTIQUE RH_COULOMB (Rounded Hyperbolic Mohr-Coulomb)
      ELSE IF (JNPLAS.eq.113) THEN
        call eco_rhmc(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
     .                NSTRSL,XMAT,KERRE,PRECIS,NITMAX,nescri,
     .                nues,kdummy)
      ENDIF
      IF (KERRE.EQ.1) THEN
c       write(*,*) ' Nonconvergence c7 at elem: ', ib,' gauss:',igau
        KERRE=99
      ENDIF
      RETURN
C======================================================================
C           MODELES VISCOPLASTIQUE ET FLUAGE VIA CCONST
C======================================================================
C     MODELE VISCOPLASTIQUE GUIONNET
  317 continue
C     MODELE FLUAGE NORTON
  319 continue
C     MODELE FLUAGE BLACKBURN
  320 continue
C     MODELE FLUAGE POLYNOMIAL
  321 continue
C     MODELE FLUAGE RCCMR-316
  322 continue
C     MODELE FLUAGE RCCMR-304
  323 continue
C     MODELE FLUAGE LEMAITRE
  324 continue
C     MODELE VISCOPLASTIQUE ONERA
  325 continue
C     MODELE VISCOPLASTIQUE POUDRE_A
  344 continue
C     MODELE VISCOPLASTIQUE POUDRE_B
  345 continue
C     MODELE VISCOPLASTIQUE OHNO
  353 continue
C     MODELE FLUAGE BLACKBURN_2
  361 continue
C     MODELE VISCOPLASTIQUE DDI
  363 continue
C     MODELE VISCOPLASTIQUE KOCKS
  370 continue
C     MODELE VISCOPLASTIQUE NOUAILHAS_A
  376 continue
C     MODELE VISCOPLASTIQUE NOUAILHAS_B
  377 continue
C     MODELE FLUAGE COMETE
  384 continue
C     MODELE FLUAGE CCPL
  385 continue
C     MODELE FLUAGE X11
  386 continue
C     MODELE FLUAGE SODERBERG
  402 continue
C     MODELE VISCOPLASTIQUE GATT_MONERIE
  407 continue
C     MODELE VISCOPLASTIQUE VISCODD
  430 continue
C     MODELE VISCOPLASTIQUE CHAB_SINH_R
  436 continue
C     MODELE VISCOPLASTIQUE CHAB_SINH_X
  437 continue
C     MODELE VISCOPLASTIQUE CHAB_NOR_R
  438 continue
C     MODELE VISCOPLASTIQUE CHAB_NOR_X
  439 continue
C     MODELE VISCOPLASTIQUE CHABOCHE
  440 continue
C
      TETA1 = ture0(1)
      TETA2 = turef(1)
      IF (JNPLAS.EQ.44) THEN
        IF (VAR0(NVARI).EQ.0.0) VAR0(NVARI)=XMAT(20)
      ELSE IF (JNPLAS.EQ.45) THEN
        IF (VAR0(NVARI).EQ.0.0) THEN
          VAR0(NVARI-2)=XMAT(20)
          VAR0(NVARI-1)=XMAT(21)
          VAR0(NVARI)=XMAT(27)
        ENDIF
      ENDIF
      FI1 = 0.D0
      FI2 = 0.D0
      IF (JNPLAS.EQ.107) THEN
        nexo = exova0(/1)
        do 50 inex = 1,nexo
          if ((nomexo(inex)          .eq.'DFIS    ').and.
     &        (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
            fi1 = exova0(inex)
            fi2 = exova1(inex)
            goto 2001
          endif
 50     continue
 2001   continue
      ENDIF
 
      if (wrk7.eq.0) then
        segini wrk7
      else
        if (f(/1).ne.ncourb) segadj wrk7
      endif
      if (wrk9.eq.0) then
        segini wrk9
      else
        if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA
     >  .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or.
     >  YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1
     >  .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or.
     >  YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX)
     >  segadj wrk9
      endif
      if (wrk91.eq.0) then
        segini wrk91
      else
        if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
     >      YALFT1(/1).ne.NYALFT1 .or.
     >      YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
     >  YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
     >  YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
     >  YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
     >  segadj wrk91
      endif
c
      iforb=ifourb
      nccor = ncourb
 
      CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
     1        NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
     4     TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
c
      ifourb=iforb
      ncourb=nccor
      IF (MFR1.EQ.17.AND.JNPLAS.EQ.19) THEN
        IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
          CALL ERREUR(KERREU1)
        ENDIF
      ENDIF
      DTOPTI  = MIN(DTOPTI,DTT)
      NINCMA = MAX(NINCMA,NSSINC)
      NCOMP = NCOMP + 1
      TSOM = TSOM + DTT
      NSOM = NSOM + NSSINC
      NINV = NINV + INV
      TCAR = TCAR + DTT* DTT
      IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
        KERR1=1
      ENDIF
      RETURN
C
C======================================================================
C     MODELE VISCOPLASTIQUE PARFAIT
C======================================================================
  343 CONTINUE
      icarbi=icara
      dtbi=dt
      iforb=ifourb
      nlmatb=nelmat
      nbgmab=nbgmat
      JMFR = mfr1
      CALL PRVPAR(SIG0,NSTRSL,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
     1            SIGF,VARF,DEFP,JMFR,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
     2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
     3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
     4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
      dt=dtbi
      ifourb=iforb
      nelmat=nlmatb
      nbgmat=nbgmab
      mfr1=JMFR
      IND = 0
      RETURN
C
C======================================================================
C     MODELE VISCOPLASTIQUE VISK2
C======================================================================
  382 continue
*      ELSE IF ( JNPLAS .EQ. 82 ) THEN
      icarbi=icara
      dtbi=dt
      iforb=ifourb
      nlmatb=nelmat
      nbgmab=nbgmat
      JMFR = mfr1
       CALL PRVIK2(SIG0,NSTRSL,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
     1            SIGF,VARF,DEFP,JMFR,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
     2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
     3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
     4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
      dt=dtbi
      ifourb=iforb
      nelmat=nlmatb
      nbgmat=nbgmab
      mfr1=JMFR
        IND = 0
      RETURN
 
C======================================================================
C     MODELE VISCOPLASTIQUE VISCOHINT
C======================================================================
  390 CONTINUE
*      ELSE IF (JNPLAS .EQ. 90) THEN
      CALL VISHIN(SIG0,NSTRSL,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF,
     &              VARF,DEFP,PRECIS,MFR1,KERRE,DT)
 
      IND =1
      RETURN
C
C======================================================================
C     MODELE VISCOPLASTIQUE MISTRAL
C======================================================================
  394 CONTINUE
*      ELSE IF (JNPLAS.EQ.94) THEN
      FI1 = 0.D0
      FI2 = 0.D0
      nexo = exova0(/1)
      do 60 inex = 1,nexo
        if ((nomexo(inex)          .eq.'FI      ').and.
     &      (conexo(inex)(1:LCONMO).eq. CONM(1:LCONMO))) then
          fi1 = exova0(inex)
          fi2 = exova1(inex)
          goto 2002
        endif
 60   continue
 2002 continue
      CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
     &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
 
      IF (WR13 .EQ. 0) SEGINI,WR13
      IF (NPDILT.NE.PDILT(/1) .OR. NPNBRE.NE.PNBRE(/1) .OR.
     &    NPCOHI.NE.PCOHI(/1) .OR. NPECOU.NE.PECOU(/1) .OR.
     &    NPEDIR.NE.PEDIR(/1) .OR. NPRVCE.NE.PRVCE(/1) .OR.
     &    NPECRX.NE.PECRX(/1) .OR. NPDVDI.NE.PDVDI(/1) .OR.
     &    NPCROI.NE.PCROI(/1) .OR. NPINCR.NE.PINCR(/1)) SEGADJ,WR13
 
      CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
     &            NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
      NDPI = nint(PNBRE(1))
      NDVP = nint(PNBRE(2))
      NXX  = nint(PNBRE(3))
      NPSI = nint(PNBRE(4))
      TETA1 = ture0(1)
      TETA2 = turef(1)
      CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
     &            TETA2,FI2,DEPST, valmat,TXR,IDIM,
     &            PDILT,NDPI,NDVP,NXX,NPSI,
     &            PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
     &            NPINCR,PINCR,  SIGF,VARF,EPINF)
C     SEGSUP WR13
      IND = 1
      RETURN
C
C======================================================================
C     MODELE FLUAGE BPEL_RELAX
C======================================================================
  395 CONTINUE
*      ELSE IF ( JNPLAS .EQ. 95 ) THEN
      icarbi=icara
      JMFR=mfr1
      iforb=ifourb
      nbgmab=nbgmat
      nlmatb=nelmat
      dtbi=dt
      CALL ECBPEL(SIG0,NSTRSL,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
     1              NVARI,SIGF,VARF,DEFP,JMFR,DDAUX,CMATE,VALMAT,
     2              VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,
     3              MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,
     4              D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
      dt=dtbi
      ifourb=iforb
      nelmat=nlmatb
      nbgmat=nbgmab
      mfr1=JMFR
      icara=icarbi
      IND = 0
      RETURN
 
C======================================================================
C     MODELES BETON_URGC
C======================================================================
C     MODELE PLASTIQUE BETON_URGC (DEBRANCHE POUR LE MOMENT GOTO 300)
  399 CONTINUE
C     MODELE VISCOPLASTIQUE BETON_URGC
  400 CONTINUE
C     MODELE FLUAGE BETON_URGC
  401 CONTINUE
C     MODELE PLASTIQUE_ENDOM BETON_URGC
  420 CONTINUE
C     MODELE VISCOPLASTIQUE BETON_URGC_ENDO
  422 CONTINUE
*      ELSE IF ((JNPLAS.GE.99.AND.JNPLAS.LE.101).OR.
*     1             (JNPLAS.EQ.120).OR.(JNPLAS.EQ.122)) THEN
c
      xlcar = bid(1)
      TETA1 = ture0(1)
      TETA2 = turef(1)
c  modele BET_URGC : CONTRAINTES PLANES,
c               DEFORMATION PLANES ET AXISYMETRIE
      if (jnplas.eq.100) inurgc = 1
C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
C               DEFORMATION PLANES ET AXISYMETRIE
      if (jnplas.eq.99) inurgc = 0
C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
C               DEFORMATION PLANES ET AXISYMETRIE
      if (jnplas.eq.101) inurgc = 2
C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
C               DEFORMATION PLANES ET AXISYMETRIE
      if (jnplas.eq.120) inurgc = 3
C  modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
C               DEFORMATION PLANES ET AXISYMETRIE
      if (jnplas.eq.122) inurgc = 4
 
      iforb=ifourb
      dtbi=dt
      CALL CURGCS(wrk52,wrk53,wrk54,MWRKXE,NSTRSL,IFORB,DTbi,IB,IGAU,
     &                xlcar,inurgc,TETA1,TETA2)
      ifourb=iforb
      dt=dtbi
      RETURN
C
C======================================================================
C     MODELE PLASTIQUE_ENDON BETON_INSA
C======================================================================
  421 CONTINUE
*      ELSE IF (JNPLAS.EQ.121) THEN
c
      xlcar = bid(1)
C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
 
      iforb=ifourb
      dtbi=dt
      CALL bet3D(wrk52,wrk53,wrk54,MWRKXE,NSTRSL,IFORB,DTbi,IB,IGAU,
     &                xlcar)
      ifourb=iforb
      dt=dtbi
      RETURN
C
C======================================================================
C     MODELES SELLIER
C======================================================================
C     MODELE VISCOPLASTIQUE FLUENDO3D DE SELLIER
487   CONTINUE
C     MODELE VISCOPLASTIQUE INCLUSION3D DE SELLIER
488   CONTINUE
C     MODELE VISCOPLASTIQUE ENDO3D DE SELLIER
489   CONTINUE
C     MODELE VISCOPLASTIQUE FLUISO3D DE SELLIER
490   CONTINUE
C     MODELE VISCOPLASTIQUE FLUORTHO3D DE SELLIER
491   CONTINUE
C
C     RECUPERATION DES TEMPERATURES
      TETA1b = ture0(1)
      TETA2b = turef(1)
c     formulation
      iforb=ifourb
c     pas de temps
      dtbi=dt
c     nbr de variables internes
      nvarib=nvari
c     nbre de noeuds ds l element
      nbnnb=NBNNBI
c     dimension espace
      idimb=idim
c     temperature de reference
      trefb=TREFA
c     coordonnees des neouds
C     ENTREE : XE    : tableau de REAL*8 de dimensions (3,NBNN),
C                      coordonnees des noeuds de l'element
C                      Ce tableau a ete rempli par la routine DOXE
C                      appelee au prealable
c      do insb=1,nbnnb
c         print*,'xel(',1,insb,')=',xe(1,insb)
c         print*,'xel(',2,insb,')=',xe(2,insb)
c         print*,'xel(',3,insb,')=',xe(3,insb)
c      end do
c      read*
c      print*,'endo3d dans coml7',teta1,teta2,'endo3d'
c      print*,'dans coml7'
 
*AM 03/04/20
      if(WR14.EQ.0) then
        NBVIA = 0
      else
        NBVIA=INLVIA(/1)
c        print*,'NBVIA = ',NBVIA
c        do i=1,NBVIA
c           print*, 'I' ,i, 'INLVIA ' ,INLVIA(i)
c        end do
      endif
* fin AM
* sellier
      IF (JNPLAS.EQ.187) THEN
        CALL cflu3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
c        Iecou,xecou,
     #   teta1b,teta2b,nvarib,NSTRSL,iforb,dtbi,trefb)
      ELSE IF (JNPLAS.EQ.188) THEN
        CALL cinc3d(WRK52,WRK53,WRK54,MWRKXE,nbnnb,idimb,
c        Iecou,xecou,
     #   teta1b,teta2b,nvarib,NSTRSL,iforb,dtbi)
      ELSE IF (JNPLAS.EQ.189) THEN
        CALL cndo3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
c        Iecou,xecou,
     #   teta1b,teta2b,nvarib,NSTRSL,iforb,dtbi,trefb)
      ELSE IF (JNPLAS.EQ.190) THEN
c        print*, 'coml7'
        CALL cflui3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
c        Iecou,xecou,
     #   teta1b,teta2b,nvarib,NSTRSL,iforb,dtbi,trefb)
      ELSE IF (JNPLAS.EQ.191) THEN
c        print*, 'coml7'
        CALL cfluo3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
c        Iecou,xecou,
     #   teta1b,teta2b,nvarib,NSTRSL,iforb,dtbi,trefb)
      ENDIF
      ifourb=iforb
      dt=dtbi
      nvari=nvarib
      xecou.TREFA=trefb
      RETURN
 
C======================================================================
C     MODELE VISCOPLASTIQUE LEMENDO
C======================================================================
  403 CONTINUE
*      ELSE IF (jnplas.eq.103) THEN
      iforb=ifourb
      nbgmab=nbgmat
      nlmatb=nelmat
      CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
     &              NLMATb,IFORB)
 
      RETURN
 
C======================================================================
C     MODELE VISCOPLASTIQUE FLUNOR2
C======================================================================
  405 CONTINUE
*      ELSE IF (jnplas.eq.105) THEN
      iforb=ifourb
      nbgmab=nbgmat
      nlmatb=nelmat
      CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
     &              NLMATb,IFORB)
      RETURN
 
C======================================================================
      END
 
 
 

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