Télécharger la plaquette Cast3M


fr en

Télécharger coml8.eso

Retour à la liste

Numérotation des lignes : 

coml8

  1. C COML8     SOURCE    OF166741  25/11/04    21:15:36     12349          
  2.       SUBROUTINE COML8(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3.      &         mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,
  4.      &         iretou,wrk12,WR12,WRKK2,wrkgur,wkumat,wcreep,
  5.      &         ecou,iecou,necou,xecou)
  6.  
  7. *----------------------------------------------------------------
  8. * lois locales pour la mecanique
  9. *  decrites au point d integration
  10. *----------------------------------------------------------------
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC CCHAMP
  18.  
  19. -INC SMMODEL
  20. -INC SMELEME
  21. -INC SMINTE
  22. -INC SMCOORD
  23.  
  24. * segment deroulant le mcheml
  25. -INC DECHE
  26.  
  27. -INC TECOU
  28.  
  29.       SEGMENT WRK2
  30.         REAL*8 TRAC(LTRAC)
  31.       ENDSEGMENT
  32.  
  33.       SEGMENT WRK3
  34.         REAL*8 WORK(LW),WORK2(LW2)
  35.       ENDSEGMENT
  36.  
  37.       SEGMENT MWRKXE
  38.         REAL*8 XE(3,NBNNbi)
  39.       ENDSEGMENT
  40.  
  41.       SEGMENT WRK6
  42.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  43.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  44.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  45.       ENDSEGMENT
  46.  
  47.       SEGMENT WRK7
  48.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  49.       ENDSEGMENT
  50.  
  51.       SEGMENT WRK8
  52.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  53.         REAL*8 DDINVp(NSTRS,NSTRS)
  54.       ENDSEGMENT
  55.  
  56.       SEGMENT WRK9
  57.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  58.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  59.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  60.         REAL*8 SIGY(NSIGY)
  61.         INTEGER NKX(NNKX)
  62.       ENDSEGMENT
  63.  
  64.       SEGMENT WRK91
  65.         REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  66.         REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  67.         REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  68.         REAL*8 SIGY1(NSIGY1)
  69.       ENDSEGMENT
  70.  
  71.       SEGMENT WR10
  72.         INTEGER IABLO1(NTABO1)
  73.         REAL*8  TABLO2(NTABO2)
  74.       ENDSEGMENT
  75.  
  76.       SEGMENT WR12
  77.         REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  78.         REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  79.         REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  80.         REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  81.         REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  82.         REAL*8  SM8(NSTRS)
  83.       ENDSEGMENT
  84.  
  85.       SEGMENT WRK12
  86.         real*8  bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  87.         real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  88.         real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  89.         real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  90.         real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  91.         real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  92.         real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  93.         integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  94.         integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  95.       ENDSEGMENT
  96.  
  97.       SEGMENT WRK22
  98.         REAL*8 XXE(3,NBNNbi)
  99.       ENDSEGMENT
  100.  
  101.       SEGMENT WRKGUR
  102.         REAL*8 WGUR1,WGUR2,WGUR3,WGUR4,WGUR5,WGUR6,WGUR7
  103.         REAL*8  WGUR8,WGUR9,WGUR10,WGUR11,WGUR12(6)
  104.         REAL*8 WGUR13(7), WGUR14
  105.         REAL*8 WGUR15,WGUR16,WGUR17
  106.       ENDSEGMENT
  107. C
  108. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  109. C l'integrateur externe specifique UMAT
  110. C
  111.       SEGMENT WKUMAT
  112. C        Entrees/sorties de la routine UMAT
  113.          REAL*8        DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  114.      &                 RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  115.      &                 TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  116.      &                 DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  117.          CHARACTER*16  CMNAME
  118.          INTEGER       NDI, NSHR, NSTATV, NPROPS,
  119.      &                 LAYER, KSPT, KSTEP, KINC
  120. C        Variables de travail
  121.          LOGICAL       LTEMP, LPRED, LVARI, LDFGRD
  122.          INTEGER       NSIG0, NPARE0, NGRAD0
  123.       ENDSEGMENT
  124. C
  125. C Segment de travail pour les lois 'VISCO_EXTERNE'
  126. C
  127.       SEGMENT WCREEP
  128. C        Entrees/sorties constantes de la routine CREEP
  129.          REAL*8        SERD
  130.          CHARACTER*16  CMNAMC
  131.          INTEGER       LEXIMP, NSTTVC, LAYERC, KSPTC
  132. C        Entrees/sorties de la routine CREEP pouvant varier
  133.          REAL*8        STV(NSTV),    STV1(NSTV),  STVP1(NSTV),
  134.      &                 STVP2(NSTV),  STV12(NSTV), STVP3(NSTV),
  135.      &                 STVP4(NSTV),  STV13(NSTV), STVF(NSTV),
  136.      &                 TMP12,        TMP,         TMP32,
  137.      &                 DTMP12,       DTMP,
  138.      &                 PRD12(NPRD),  PRD(NPRD),   PRD32(NPRD),
  139.      &                 DPRD12(NPRD), DPRD(NPRD)
  140.          INTEGER       KSTEPC
  141. C        Autres indicateurs et variables de travail
  142.          LOGICAL       LTMP, LPRD, LSTV
  143.          INTEGER       IVIEX, NPAREC
  144.          REAL*8        dTMPdt, dPRDdt(NPRD)
  145.       ENDSEGMENT
  146. *
  147.       REAL*8 CRIGI(12)
  148.       DIMENSION NWA(9)
  149.       DIMENSION SIG01(8),VAR01(37)
  150.       DIMENSION EPSFLU(8)
  151.  
  152.       INTEGER WRKK2
  153.  
  154. c     moterr(1:6) = 'COML8  '
  155. c     moterr(7:15) = 'element '
  156. c     interr(1) = ib
  157. c     interr(2) = igau
  158. c     call erreur(-329)
  159. *     write(6,*) ' entrée dans coml8 iecou ', iecou
  160.  
  161.       NSSINC = 0
  162.       INV    = 0
  163.       NBPGAU = wrk53.nbgs
  164.       NVARI = wrk53.NVART
  165.       TETA1 = wrk52.ture0(1)
  166.       TETA2 = wrk52.turef(1)
  167.       SUCC1 = -1.E35
  168.       SUCC2 = -1.E35
  169.       nexo = wrk52.exova0(/1)
  170.       if (nexo.gt.0) then
  171.         do 1296 inex = 1,nexo
  172.           if ((nomexo(inex)(1:4)     .eq.'SUCC').and.
  173.      &        (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  174.             SUCC1 = wrk52.exova0(inex)
  175.             SUCC2 = wrk52.exova1(inex)
  176.             goto 1295
  177.           endif
  178.  1296   continue
  179.  1295   continue
  180.       endif
  181. C
  182.       iforb = necou.ifourb
  183.       jnplas = wrk53.INPLAS
  184.  
  185.       knplas = jnplas + 3
  186. *  inplas      -2    -1     0
  187.       GOTO (  898,  899,  900,
  188. *  inplas   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  189.      $     900,302,900,900,900,900,900,900,309,900,900,900,900,314,900,
  190.      $     316,900,900,900,900,900,900,900,900,900,326,327,328,329,330,
  191. *           31
  192.      $     331,332,333,334,335,336,337,338,339,340,341,342,900,900,900,
  193.      $     900,347,348,349,900,900,352,900,354,355,356,357,358,359,360,
  194. *           61
  195.      $     900,362,900,364,365,366,367,368,369,900,371,372,373,374,375,
  196.      $     900,900,378,379,380,900,900,900,900,900,900,900,388,389,900,
  197. *           91
  198.      $     391,392,393,900,900,396,397,398,900,900,900,900,900,404,900,
  199.      $     406,900,408,900,900,900,900,900,900,900,900,900,418,419,900,
  200. *          121
  201.      $     900,900,900,900,425,900,427,428,429,900,431,432,433,434,435,
  202.      $     900,900,900,900,440,441,442,443,900,900,900,447,448,900,450,
  203. *          151 152         155 156 157 158 159 160 161 162 163 164 165
  204.      $     451,452,900,900,455,456,900,900,900,900,900,900,900,900,900,
  205. *          166 167 168 169 170 171 172 173 174
  206.      $     900,900,900,900,900,900,900,900,474
  207.      $ ) knplas
  208. C
  209. C======================================================================
  210.   900 CONTINUE
  211.       WRITE(6,*) ' ERREUR D AIGUILLAGE COML8'
  212.       CALL ERREUR (5)
  213.       RETURN
  214. C
  215. C======================================================================
  216. C     MODELE VISCOPLASTIQUE VISCODOMMAGE
  217. C======================================================================
  218.   329 CONTINUE
  219.       ntabo1 = iablo1(/1)
  220.       ntabo2 = tablo2(/1)
  221. *
  222.       NYOG=IABLO1(1)
  223.       NYNU=IABLO1(2)
  224.       NYALFA=IABLO1(3)
  225.       NYSMAX=IABLO1(4)
  226.       NYN=IABLO1(5)
  227.       NYM=IABLO1(6)
  228.       NYKK=IABLO1(7)
  229.       NYALF1=IABLO1(8)
  230.       NYBET1=IABLO1(9)
  231.       NYR=IABLO1(10)
  232.       NYA=IABLO1(11)
  233. C
  234.       INTMAT=NMATT
  235. C
  236.       IF (NTABO1.EQ.INTMAT) THEN
  237.         NNKX=1
  238.         NYKX=IABLO1(12)
  239.       ELSE
  240.         NNKX=IABLO1(12)
  241.         NYKX=0
  242.         DO 1881 I=1,NNKX
  243.           NYKX=NYKX+(2*IABLO1(12+I))
  244.  1881   CONTINUE
  245.         NYKX=NYKX+NNKX
  246.       ENDIF
  247.       NYRHO=IABLO1(NTABO1)
  248.       NSIGY=1
  249. ***   SEGINI WRK9
  250.       if (wrk9.eq.0) segini wrk9
  251.       if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  252.      >   .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  253.      >   ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  254.      >   ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  255.      >   ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  256.      >   .or.nkx(/1).ne.nnkx) segadj wrk9
  257.       ifor2 = IFOUR
  258.       mfr2 = MFRbi
  259.       CALL MAT29(WR10,WRK9,jnplas,ifor2,mfr2)
  260. ***   SEGSUP WR10
  261.       IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  262.         NCOURB=2*NKX(1)
  263.       ELSE
  264.         NCOURB=NKX(1)
  265.         DO 1882 I=1,NNKX
  266.           IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  267.  1882   CONTINUE
  268.         NCOURB=2*NCOURB
  269.       ENDIF
  270. **      SEGINI WRK7
  271.       if (wrk7.eq.0) segini wrk7
  272.       if (w(/1).ne.ncourb) segadj wrk7
  273.  
  274.       IF (VAR0(3).GE.0.96) THEN
  275.         CALL ZDANUL(SIGF,NSTRS)
  276.         DO 1883 I=1,NVARI
  277.           VARF(I) = VAR0(I)
  278.  1883   CONTINUE
  279.         VARF(3) = 1.D0
  280.         DO 1884 I=1,NSTRS
  281.           EPINF(I) = EPIN0(I)
  282.  1884   CONTINUE
  283.       ELSE
  284.         FI1=0.D0
  285.         FI2=0.D0
  286.         dtbi=dt
  287.         nccor = necou.ncourb
  288.         TLIFE = 0.D0
  289.        CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  290.      1     NVARI,NSSINC,INV,iforb,TETA1,TETA2,FI1,FI2,
  291.      4     TLIFE,nccor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  292.         ncourb=nccor
  293. c
  294.         IF (TLIFE.GE.0.D0) THEN
  295.           INTERR(1)=IB
  296.           INTERR(2)=IGAU
  297.           REAERR(1)=TLIFE
  298.           CALL ERREUR(-279)
  299.         ENDIF
  300.         DTOPTI  = MIN(DTOPTI,DTT)
  301.         NINCMA = MAX(NINCMA,NSSINC)
  302.         NCOMP = NCOMP + 1
  303.         TSOM = TSOM + DTT
  304.         NSOM = NSOM + NSSINC
  305.         NINV = NINV + INV
  306.         TCAR = TCAR + DTT* DTT
  307.         IF (KERRE.NE.0) THEN
  308.           KERR1=1
  309.         ENDIF
  310.       ENDIF
  311.       RETURN
  312. C
  313. C======================================================================
  314. C     MODELE VISCOPLASTIQUE PELLET
  315. C======================================================================
  316.   442 CONTINUE
  317.  
  318.       ntabo1 = iablo1(/1)
  319.       ntabo2 = tablo2(/1)
  320. *
  321.       NYOG1=IABLO1(1)
  322.       NYNU1=IABLO1(2)
  323.       NYALFT1=IABLO1(3)
  324.       NYSMAX1=IABLO1(4)
  325.       NYN1=IABLO1(5)
  326.       NYM1=IABLO1(6)
  327.       NYKK1=IABLO1(7)
  328.       NYALF2=IABLO1(8)
  329.       NYBET2=IABLO1(9)
  330.       NYR1=IABLO1(10)
  331.       NYA1=IABLO1(11)
  332.       NYQ1=IABLO1(12)
  333.       NYRHO1=IABLO1(NTABO1)
  334.       NSIGY1=1
  335. ***        SEGINI WRK91
  336.       if (wrk91.eq.0) segini wrk91
  337.       if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  338.      >      YALFT1(/1).ne.NYALFT1 .or.
  339.      >      YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  340.      >  YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  341.      >  YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  342.      >  YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  343.      >  segadj wrk91
  344.       ifor2 = IFOUR
  345.       mfr2 = MFRbi
  346.       CALL MAT142(WR10,WRK91,jnplas,ifor2,mfr2)
  347. ***   SEGSUP WR10
  348. **    SEGINI WRK7
  349.       if (wrk7.eq.0) segini wrk7
  350.       if (w(/1).ne.ncourb) segadj wrk7
  351.       IF (VAR0(8).GE.0.96) THEN
  352.         CALL ZDANUL(SIGF,NSTRS)
  353.         DO I=1,NVARI
  354.           VARF(I) = VAR0(I)
  355.         ENDDO
  356.         VARF(8) = 1.D0
  357.         DO I=1,NSTRS
  358.           EPINF(I) = EPIN0(I)
  359.         ENDDO
  360.       ELSE
  361.         FI1=0.D0
  362.         FI2=0.D0
  363.         dtbi=dt
  364.         nccor = necou.ncourb
  365.         TLIFE = 0.D0
  366.        CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  367.      1           NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  368.      4           TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  369. c*        segact necou*mod
  370.         necou.ncourb = nccor
  371. c
  372.         IF (TLIFE.GE.0.D0) THEN
  373.           INTERR(1)=IB
  374.           INTERR(2)=IGAU
  375.           REAERR(1)=TLIFE
  376.           CALL ERREUR(-279)
  377.         ENDIF
  378.         DTOPTI  = MIN(DTOPTI,DTT)
  379.         NINCMA = MAX(NINCMA,NSSINC)
  380.         NCOMP = NCOMP + 1
  381.         TSOM = TSOM + DTT
  382.         NSOM = NSOM + NSSINC
  383.         NINV = NINV + INV
  384.         TCAR = TCAR + DTT* DTT
  385.         IF (KERRE.NE.0) THEN
  386.           KERR1=1
  387.         ENDIF
  388.       ENDIF
  389.       SEGSUP WRK7
  390. ***   SEGSUP WRK91
  391.       RETURN
  392. C
  393. C======================================================================
  394. C     MODELE PLASTIQUE ENDOMMAGEABLE
  395. C======================================================================
  396. c        modele plastique d'endommagement de lemaitre
  397. c        ++++++++++++++++++++++++++++++++++++++++++++
  398. c  traitement du materiau qui depend eventuellement de la temperature
  399. c  ------------------------------------------------------------------
  400.   326 CONTINUE
  401.         ntabo1 = iablo1(/1)
  402.         ntabo2 = tablo2(/1)
  403.         NYOG=IABLO1(1)
  404.         NYNU=IABLO1(2)
  405.         NYRHO=IABLO1(3)
  406.         NYALFA=IABLO1(4)
  407. c        IF ((MFRbi.EQ.1.OR.MFRbi.EQ.31.OR.MFRbi.EQ.33).AND.IFOUR.EQ.-2)
  408. c     &   THEN
  409. c+DC      INTMAT=9
  410. c          INTMAT=10
  411. c        ELSE
  412. c+DC      INTMAT=8
  413. c          INTMAT=9
  414. c        ENDIF
  415.         INTMAT=NMATT
  416.         IF (NTABO1.EQ.INTMAT) THEN
  417.           NNKX=1
  418.           NYKX=IABLO1(5)
  419.           IEPS=0
  420.         ELSE
  421.           NNKX=IABLO1(5)
  422.           NYKX=0
  423.           DO 1789 I=1,NNKX
  424.             NYKX=NYKX+(2*IABLO1(5+I))
  425.  1789     CONTINUE
  426.           NYKX=NYKX+NNKX
  427.           IEPS=1
  428.         ENDIF
  429.         IORIGI=6+(IEPS*NNKX)
  430.         NYN=IABLO1(IORIGI)
  431.         NYM=IABLO1(IORIGI+1)
  432.         NYKK=IABLO1(IORIGI+2)
  433.         NYSMAX=0
  434.         NYALF1=0
  435.         NYBET1=0
  436.         NYR=0
  437.         NYA=0
  438.         NSIGY=0
  439. **        SEGINI WRK9
  440.         if (wrk9.eq.0) segini wrk9
  441.         if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  442.      >   .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  443.      >   ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  444.      >   ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  445.      >   ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  446.      >   .or.nkx(/1).ne.nnkx) segadj wrk9
  447.         iforb = IFOUR
  448.         mfr2 = MFRbi
  449. *         write(6,*) ' coml8 jnplas ifour2 mfr2 ifourb'
  450. *        write(6,*) jnplas,iforb,mfr2,ifourb
  451.         CALL MAT29(WR10,WRK9,jnplas,iforb,mfr2)
  452. *        write(6,*) ' sortier de mat29 kerre',kerre
  453. ***     SEGSUP WR10
  454. c
  455. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  456. c *** on n' ecoule pas
  457. c
  458.         CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  459.         IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  460.           DO 1115 IEN=1,NVARI
  461.             VARF(IEN)=VAR0(IEN)
  462. 1115      continue
  463.           VARF(3)=1.D0
  464.           CALL ZDANUL(SIGF,NSTRS)
  465.           CALL ZDANUL(DEFP,NSTRS)
  466.         ELSE
  467. c ----------------------------------------------------------------------
  468. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  469. c                     p est en supplement
  470. c ----------------------------------------------------------------------
  471.           NNVARI=2
  472.           IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  473.             nccor=necou.ncourb
  474.             CALL CCOTR4(WRK52,WRK2,Nccor,WRK53)
  475.             NCOURB=2*NKX(1)
  476.           ELSE
  477.             NCOURB=NKX(1)
  478.             DO 1119 I=1,NNKX
  479.               if (nkx(i).ge.ncourb) ncourb=nkx(i)
  480. 1119        CONTINUE
  481.             NCOURB=4*NCOURB
  482.           ENDIF
  483.           IF (KERRE.EQ.0) THEN
  484. **          SEGINI WRK7
  485.         if (wrk7.eq.0) segini wrk7
  486.         if (w(/1).ne.ncourb) segadj wrk7
  487.             trefab=trefa
  488.             nccor = necou.ncourb
  489.             CALL CENDOM(wrk52,wrk53,wrk54,WRK6,WRK7,WRK8,WRK9,
  490.      1       NVARI, TETA1,TETA2,TREFAb,IB,IGAU,iforb,nccor,iecou)
  491.             necou.ncourb = nccor
  492.             trefa=trefab
  493. **          SEGSUP WRK7
  494.             IF (KERRE.GT.200) THEN
  495.                KERR1=1
  496.             ENDIF
  497.           ENDIF
  498.         ENDIF
  499. **        SEGSUP WRK9
  500.       RETURN
  501. C
  502. C======================================================================
  503. C     MODELE PLASTIQUE_ENDOM ROUSSELIER
  504. C======================================================================
  505.  362  CONTINUE
  506. c
  507. c  Modèle d'endommagement de Rousselier
  508. c   - on recupère la courbe de traction
  509. c
  510.         nccor=necou.ncourb
  511.         CALL CCOTRA(wrk52,WRK2,nccor,wrk53)
  512.         necou.ncourb=nccor
  513. c
  514. c   - appel au modèle
  515. C
  516.         IF (KERRE.EQ.0) THEN
  517.           CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  518.      &               XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  519.      &  necou)
  520.           IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  521.             KERR1=1
  522.           ENDIF
  523.         ENDIF
  524.         RETURN
  525. C
  526. C======================================================================
  527. C     MODELE PLASTIQUE_ENDOM GURSON2
  528. C======================================================================
  529.  364  CONTINUE
  530. c
  531. c  Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  532. c   - on recupère la courbe de traction
  533. c
  534.         nccor=necou.ncourb
  535.         CALL CCOTRA(wrk52,WRK2,nccor,wrk53)
  536.         necou.ncourb=nccor
  537. c
  538. c   - appel au modèle
  539. c
  540.         IF (KERRE.EQ.0) THEN
  541.           CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  542.      &                XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  543.      &                nccor)
  544.           IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  545.             KERR1=1
  546.           ENDIF
  547.         ENDIF
  548.         RETURN
  549. C
  550. C======================================================================
  551. C     MODELE PLASTIQUE_ENDOM DRAGON
  552. C======================================================================
  553.  375  CONTINUE
  554. c
  555. c  Modèle d'endommagement de Dragon
  556. c
  557.       CALL CDRAGO(wrk52,wrk53,wrk54)
  558.       RETURN
  559. C
  560. C======================================================================
  561. C     MODELE PLASTIQUE_ENDOM BETON_DYNAR_LMT
  562. C======================================================================
  563.  433  CONTINUE
  564. c
  565. c  Modèle viscoplastique viscoendommageable pour la dynamique rapide du LMT
  566. c
  567.       CALL DYNAR(wrk52,wrk53,wrk54,iecou)
  568.       RETURN
  569. C
  570. C======================================================================
  571. C     MODELE ENDOMMAGEABLE MAZARS
  572. C======================================================================
  573.   330  CONTINUE
  574.       CALL CMAZZZ(WRK52,WRK53,WRK54,WRKK2,NVARI,iecou)
  575.       RETURN
  576. C
  577. C======================================================================
  578. C     MODELE ENDOMMAGEABLE UNILATERAL (beton)
  579. C======================================================================
  580.   331 CONTINUE
  581.       CALL COLBBB(WRK52,WRK53,WRK54,NVARI,iecou,necou)
  582.       RETURN
  583. C
  584. C======================================================================
  585. C     MODELE ENDOMMAGEABLE ROTATING_CRACK
  586. C======================================================================
  587.   337 continue
  588. c*?      nstrbi = iecou.nstrss
  589.       nstrbi = nstrs
  590.       icarbi =iecou.icara
  591.       CALL COTATI(wrk52,wrk53,wrk54,nstrbi,NVARI,icarbi)
  592.       RETURN
  593. C
  594. C======================================================================
  595. C     MODELE ENDOMMAGEABLE SIC_SIC
  596. C======================================================================
  597.   388 CONTINUE
  598.       CALL CICSIC(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  599.      &  ,iecou)
  600.       RETURN
  601. C
  602. C======================================================================
  603. C     MODELE PLASTIQUE HINT
  604. C======================================================================
  605.   389 CONTINUE
  606.       CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,xcarb,SIGF,
  607.      &             VARF,DEFP,PRECIS,MFR1,KERRE)
  608.       RETURN
  609. C
  610. C======================================================================
  611. C     MODELE ENDOMMAGEABLE MICROPLANS
  612. C======================================================================
  613.   396 CONTINUE
  614. C
  615. C     MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS
  616. C
  617.       CALL CMICRO(WRK52,WRK53,WRK54,NVARI,iecou)
  618.       RETURN
  619. C
  620. C======================================================================
  621. C     MODELE ENDOMMAGEABLE VISCOUNILATERAL (beton)
  622. C======================================================================
  623.   397 CONTINUE
  624.       CALL CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  625.       RETURN
  626. C
  627. C======================================================================
  628. C     MODELE ENDOMMAGEABLE MICROISO
  629. C======================================================================
  630.   398 CONTINUE
  631. C
  632. C     MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS
  633. C
  634.       CALL CMICRI(WRK52,WRK53,WRK54,NVARI,iecou)
  635.       RETURN
  636. C
  637. C======================================================================
  638. C     MODELE ENDOMMAGEABLE MVM (Modified Von Mises)
  639. C======================================================================
  640.   418 CONTINUE
  641.       CALL CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  642.       RETURN
  643. C
  644. C======================================================================
  645. C     MODELE ENDOMMAGEABLE SICSCAL
  646. C======================================================================
  647.   431 CONTINUE
  648.       CALL SICSCAL(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  649.      &  ,iecou)
  650.       RETURN
  651. C
  652. C======================================================================
  653. C     MODELE ENDOMMAGEABLE SICTENS
  654. C======================================================================
  655.   432 CONTINUE
  656.       CALL SICTENS(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  657.      &  ,iecou)
  658.       RETURN
  659. C
  660. C======================================================================
  661. C     MODELE ENDOMMAGEABLE DESMORAT
  662. C======================================================================
  663.   434 CONTINUE
  664.       CALL DESMOR(wrk52,wrk53,wrk54,nvari,iecou)
  665.       RETURN
  666. C
  667. C======================================================================
  668. C     MODELE PLASTIQUE LINESPRING
  669. C======================================================================
  670.   302 CONTINUE
  671.   327 CONTINUE
  672.       CALL CLISPP(wrk52,wrk53,wrk54,WRK2,IFOUR,IB,IGAU,NBPGAU,iecou)
  673.       RETURN
  674. C
  675. C======================================================================
  676. C     MODELE PLASTIQUE BETON
  677. C======================================================================
  678.   309 CONTINUE
  679.       CALL  BETON(SIG0     ,DEPST,VAR0,XMAT,ivalma,NMATT,xcarb,
  680.      1            DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,       IB,
  681.      2            IGAU,EPAIST,MELE,NPINT,              SECT,LHOOK,
  682.      3            TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,
  683.      4            SIGF,VARF,DEFP,     NBPGAU,KERRE,ecou,necou,iecou)
  684.       IF (KERRE.GT.200) THEN
  685.         KERR1=1
  686.       ENDIF
  687.       RETURN
  688. C
  689. C======================================================================
  690. C     MODELE PLASTIQUE TUYAU-FISSURE
  691. C======================================================================
  692.   314 CONTINUE
  693. C
  694.       IF(XMAT(8).NE.0.D0 .OR. XMAT(9).NE.0.D0) THEN
  695.         INPLAS=18
  696.         XMAT(5)=XMAT(8)
  697.         XMAT(6)=XMAT(9)
  698.         xmat0(5)=xmat0(8)
  699.         xmat0(6)=xmat0(9)
  700.       ENDIF
  701.  
  702.       CALL CTUFPL(wrk52,wrk53,wrk54,WRK2,IFORB,IB,IGAU,NBPGAU,iecou)
  703.  
  704. c pas de materiau 18 dans nomate 02/01 Kich
  705.       if (inplas.eq.18) inplas = 14
  706.       RETURN
  707. C
  708. C======================================================================
  709. C     MODELE PLASTIQUE GAUVAIN
  710. C======================================================================
  711.   316 CONTINUE
  712. c
  713. c     on recupere les courbes moment-courbure
  714. c
  715.       nccor = necou.ncourb
  716.       CALL CCOTR2(wrk52,wrk53,WRK2,nccor)
  717.       IF (KERRE.NE.0) RETURN
  718.       necou.ncourb = nccor
  719.       mfr1bi = iecou.mfr1
  720.       nbgmab = iecou.nbgmat
  721.       nlmatb = iecou.nelmat
  722.       nstrbi = iecou.nstrss
  723.       CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,MFR1bi,IFORB,
  724.      1               IB,IGAU,EPAIST,MELE,NPINT,NBGMAb,NLMATb,SECT,
  725.      2               LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,
  726.      3               SIG0,NSTRbi,DEPST,VAR0,XMAT,NCOMAT,xcarb,TRAC,
  727.      4               nccor,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE)
  728.  
  729.       IF (KERRE.GT.200) THEN
  730.         KERR1=1
  731.       ENDIF
  732.       RETURN
  733. C
  734. C======================================================================
  735. C     MODELE PLASTIQUE UBIQUITOUS
  736. C======================================================================
  737.   328 CONTINUE
  738.       CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,      IB,
  739.      1              IGAU,EPAIST,MELE,NPINT              ,SECT,LHOOK,
  740.      2              TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,
  741.      3                    DEPST,VAR0,XMAT,NBPGAU,NMATT,xcarb,DSIGT,
  742.      4              SIGF,VARF,DEFP,KERRE,ecou,necou,iecou)
  743.       IF (KERRE.GT.200) THEN
  744.         KERR1=1
  745.       ENDIF
  746.       RETURN
  747. C
  748. C======================================================================
  749. C     MODELE PLASTIQUE GLOBAL
  750. C======================================================================
  751.   332 CONTINUE
  752.       CALL CCOTR3(wrk52,wrk53,wrk54,IFORB,IB,IGAU,iecou)
  753.       IF (KERRE.LT.0) THEN
  754.         INTERR(1)=IB
  755.         INTERR(2)=IGAU
  756.         IF (KERRE.LE.(-4)) THEN
  757.           MOTERR(5:16) = 'CISAILLEMENT'
  758.           CALL ERREUR(-283)
  759.           KERRE = KERRE + 4
  760.         ENDIF
  761.         IF (KERRE.LE.(-2)) THEN
  762.           MOTERR(5:16) = 'FLEXION'
  763.           CALL ERREUR(-283)
  764.           KERRE = KERRE + 2
  765.         ENDIF
  766.         IF (KERRE.LT.0) THEN
  767.           MOTERR(5:16) = 'COMPRESSION'
  768.           CALL ERREUR(-283)
  769.           KERRE = 0
  770.         ENDIF
  771.       ENDIF
  772.       RETURN
  773. C
  774. C======================================================================
  775. C     MODELE PLASTIQUE CAM_CLAY
  776. C======================================================================
  777.   333 CONTINUE
  778.       CALL CAMCLA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  779.      &            VARF,DEFP,PRECIS,MFR1,KERRE)
  780.       RETURN
  781. C
  782. C======================================================================
  783. C     MODELE PLASTIQUE COULOMB
  784. C======================================================================
  785.   334 CONTINUE
  786. c
  787. c     modele de mohr coulomb pour les joints
  788. c
  789.       IF (MFR.EQ.35) THEN
  790.         IF (IFOUR.EQ.2) THEN
  791. c
  792. c --------------------joints 3d
  793. c
  794.           CALL COUL3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFORB,
  795.      &               XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  796.         ELSE
  797. c
  798. c --------------------joints 2d
  799. c
  800.           CALL COUL2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFORB,
  801.      &               XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  802.         ENDIF
  803. c
  804. c --------------------joints JOI1
  805. c
  806.       ELSE IF (MFR.EQ.75) THEN
  807.         CALL COUL1(IB,IGAU,NSTRS,SIG0,EPST0,EPIN0,VAR0,NVARI,DEPST,
  808.      &             IFORB,XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  809.       ENDIF
  810.       RETURN
  811. C
  812. C======================================================================
  813. C     MODELE PLASTIQUE JOINT_DILATANT
  814. C======================================================================
  815.   335 CONTINUE
  816. c
  817. c     modele de coulomb_dilatant  pour les joints 2d
  818. c
  819.       IF (IFOUR.NE.2) THEN
  820.         CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  821.       ENDIF
  822.       RETURN
  823. C
  824. C======================================================================
  825. C     MODELE PLASTIQUE GURSON
  826. C======================================================================
  827.   338 CONTINUE
  828.       nstrbi=iecou.nstrss
  829.       icarbi=iecou.icara
  830.       CALL PRGURS(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  831.      &              NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur)
  832.       RETURN
  833. C
  834. C======================================================================
  835. C     MODELE PLASTIQUE BETON_AXI
  836. C======================================================================
  837.   336 CONTINUE
  838.       nstrbi=iecou.nstrss
  839.       CALL BETAXI(SIG0,nstrbi,DSIGT,VAR0,XMAT,ivalma,NMATT,xcarb,
  840.      &            SIGF,VARF,DEFP,MFR1,KERRE,ecou,necou)
  841.       IF (KERRE.GT.200) THEN
  842.         KERR1=1
  843.       ENDIF
  844.       RETURN
  845. C
  846. C======================================================================
  847. C     MODELE PLASTIQUE BETON_UNI
  848. C======================================================================
  849.   339 CONTINUE
  850. c
  851. c     modele beton_uni pour les elements unidirectionels (barre ..)
  852. c
  853.       KERR1=0
  854.       CALL BARBET(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  855.       RETURN
  856. C
  857. C======================================================================
  858. C     MODELE PLASTIQUE UNILATERAL
  859. C======================================================================
  860.   404 CONTINUE
  861. c
  862. c     modele beton unilateral pour les elements unidirectionels (barre ..)
  863. c
  864.       KERR1=0
  865.       CALL BARLAB(XMAT,XCARB,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  866.       RETURN
  867. C
  868. C======================================================================
  869. C     MODELE PLASTIQUE ACIER_ANCRAGE
  870. C======================================================================
  871.   393 CONTINUE
  872. c
  873. c     modele ancrage_acier pour les elements unidirectionels (barre ..)
  874. c
  875.       KERR1=0
  876.       CALL BARSTA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  877.       RETURN
  878. C
  879. C======================================================================
  880. C     MODELE PLASTIQUE FRAGILE_UNI
  881. C======================================================================
  882.   378 CONTINUE
  883. c
  884. c     modele fragile_uni pour les elements unidirectionels (barre ..)
  885. c
  886.       KERR1=0
  887.       CALL BARFRA(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  888.       RETURN
  889. C
  890. C======================================================================
  891. C     MODELE PLASTIQUE BETON_BAEL
  892. C======================================================================
  893.   379 CONTINUE
  894. c
  895. c     modele beton_bael pour les elements unidirectionels (barre ..)
  896. c
  897.       KERR1=0
  898.       CALL BABAEL(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  899.       RETURN
  900. C
  901. C======================================================================
  902. C     MODELE PLASTIQUE CINEMATIQUE_ANCRAGE
  903. C======================================================================
  904.   392 CONTINUE
  905. c
  906. c
  907. c     modele ancrage_parfait pour les elements unidirectionels (barre ..)
  908. c
  909.       KERR1=0
  910.       CALL BARPAA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  911.       RETURN
  912. C
  913. C======================================================================
  914. C     MODELE PLASTIQUE PARFAIT_UNI
  915. C======================================================================
  916.   380 CONTINUE
  917. c
  918. c     modele parfait_uni pour les elements unidirectionels (barre ..)
  919. c
  920.       KERR1=0
  921.       CALL BARPAR(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  922. *              IF (KERRE.NE.0) return
  923.       RETURN
  924. C
  925. C======================================================================
  926. C     MODELE PLASTIQUE ACIER_UNI
  927. C======================================================================
  928.   340  CONTINUE
  929.        IF (MFRbi .EQ. 27) then
  930. c
  931. c        modele acier_uni pour les elements unidirectionels (barre ..)
  932. c
  933.          KERR1=0
  934.          CALL BARSTE(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  935. C
  936.        elseif(MATE.EQ.4) then
  937.          nstrbi=nstrss
  938.          mfr1bi=mfr1
  939.          CALL CUNIAC(wrk52,wrk53,wrk54,NSTRbi,MFR1bi)
  940. C
  941.       endif
  942.       RETURN
  943. C
  944. C======================================================================
  945. C     MODELE PLASTIQUE SECTION
  946. C======================================================================
  947.   341 CONTINUE
  948. c
  949. c     modele poutre en formulation section
  950. c
  951.       nstrbi=iecou.nstrss
  952.       icarbi=iecou.icara
  953.       CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  954.       RETURN
  955. C
  956. C======================================================================
  957. C     MODELE PLASTIQUE STEINBERG
  958. C======================================================================
  959.   349 CONTINUE
  960.       nstrbi=iecou.nstrss
  961.       icarbi=iecou.icara
  962.       CALL STEINB(DEPST,nstrbi,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  963.      1            XMAT,xcarb,NVARI,icarbi,SIGF,VARF,DEFP,TETA1,TETA2,
  964.      2              KERRE)
  965.        IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  966.          KERR1=1
  967.        ENDIF
  968.        RETURN
  969. C
  970. C======================================================================
  971. C     MODELE PLASTIQUE HUJEUX
  972. C======================================================================
  973.   348 CONTINUE
  974.       CALL HUJEUX(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  975.      &            VARF,DEFP,PRECIS,MFR1,KERRE)
  976.       RETURN
  977. C
  978. C======================================================================
  979. C     MODELE PLASTIQUE OTTOSEN
  980. C======================================================================
  981.  342  CONTINUE
  982.       CALL OTTOSE(JNPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,NMATT,
  983.      1            xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,IB,IGAU)
  984.       RETURN
  985. C
  986. C======================================================================
  987. C     MODELE PLASTIQUE OTTOVARI
  988. C======================================================================
  989.  448  CONTINUE
  990.       IF (IFOUR.NE.2) THEN
  991.         KERRE=99
  992.       ELSE
  993.         CALL OTTVA1(NMATT,XMAT,NVARI,VAR0,NSTRSS,SIG0,DEPST,
  994.      &                               VARF,       SIGF,      KERRE)
  995.  
  996.       ENDIF
  997.       RETURN
  998. C
  999. C======================================================================
  1000. C     MODELE PLASTIQUE AMADEI
  1001. C======================================================================
  1002.   347 CONTINUE
  1003. c
  1004. c     modele de amadei-saeb pour les joints
  1005. c
  1006. C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi
  1007.       IF (IFOUR.EQ.2) THEN
  1008. c
  1009. c --------------------joints 3d
  1010. c
  1011.         CALL AMADE3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFORB,
  1012.      &              XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1013.       ELSE
  1014. c
  1015. c --------------------joints 2d
  1016. c
  1017.         CALL AMADE2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFORB,
  1018.      &              XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1019.       ENDIF
  1020.       RETURN
  1021. C
  1022. C======================================================================
  1023. C     MODELE PLASTIQUE PRESTON
  1024. C======================================================================
  1025.   352 CONTINUE
  1026. c
  1027. c     modèle Preston-Tonks-Wallace
  1028. c
  1029. c   on recupere le pas de temps dt : voir comval
  1030. c kich : fixe dt = 0. pour plasticite
  1031.       dtk1 = dt
  1032.       dt = 0.d0
  1033. c
  1034.       CALL PRESTO(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1035.      1            XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1036.      2            KERRE,DT)
  1037.       IF (KERRE.NE.0) THEN
  1038.         KERR1=1
  1039.       ENDIF
  1040.       dt = dtk1
  1041.       RETURN
  1042. C
  1043. C======================================================================
  1044. C     MODELE PLASTIQUE BETOCYCL
  1045. C======================================================================
  1046.   354 CONTINUE
  1047. c
  1048. c     modele BETOCYCL
  1049. C
  1050. C     ON VERIFIE LES CONTRAINTES PLANES
  1051. C
  1052.       IF (IFOUR.EQ.-2) THEN
  1053. C
  1054. C     ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION
  1055. C
  1056.         IPOS1=1
  1057.         CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1058.         NTRAT=NPOINT/2
  1059.         IPOS2=IPOS1+NPOINT
  1060.         CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1061.         NTRAC=NPOINT/2
  1062.         IF (KERRE.EQ.0) THEN
  1063.           CALL CBETOC(wrk52,wrk53,wrk54,WRK2,NTRAT,NTRAC)
  1064.         ENDIF
  1065.       ELSE
  1066.         KERRE = 99
  1067.       ENDIF
  1068.       RETURN
  1069. C
  1070. C======================================================================
  1071. C     MODELE PLASTIQUE ROTATING_CRACK
  1072. C======================================================================
  1073.   355 CONTINUE
  1074. C
  1075. C     ON VERIFIE LES CONTRAINTES PLANES
  1076. C
  1077.       IF (IFOUR.EQ.-2) THEN
  1078.         IF (KERRE.EQ.0) THEN
  1079.           CALL CROTAT(wrk52,wrk53,wrk54)
  1080.         ENDIF
  1081.       ELSE
  1082.         KERRE = 99
  1083.       ENDIF
  1084.       RETURN
  1085. C
  1086. C======================================================================
  1087. C     MODELE PLASTIQUE JOINT_SOFT
  1088. C======================================================================
  1089.   356 CONTINUE
  1090. C
  1091. C     ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR
  1092. C
  1093. C
  1094. C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est
  1095. C       6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1096. C       'ALFA' a la place 3 et 4 dans defmat.eso
  1097. C
  1098.       IPOS1=1
  1099.       CALL COTRAJ(wrk52,wrk53,WRK2,8, IPOS1,1, NPOINT)
  1100.       NTRAC=NPOINT/2
  1101.       IPOS2=IPOS1+NPOINT
  1102.       CALL COTRAJ(wrk52,wrk53,WRK2,9, IPOS2,1, NPOINT)
  1103.       NTRAS=NPOINT/2
  1104.       IPOS3=IPOS2+NPOINT
  1105.       CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS3,1, NPOINT)
  1106.       NTRAT=NPOINT/2
  1107. C
  1108.       IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1109.         IF(KERRE.EQ.0) THEN
  1110. C
  1111.           CALL SJONL2(SIG0,DEPST,VAR0,XMAT,
  1112.      .                TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS,
  1113.      .                TRAC(IPOS3),NTRAT,
  1114.      .                SIGF,VARF,DEFP,KERRE)
  1115.         END IF
  1116.       ELSEIF(IFOUR.EQ.2)THEN
  1117.         IF(KERRE.EQ.0) THEN
  1118. C
  1119.           CALL SJONL3(SIG0,DEPST,VAR0,XMAT,
  1120.      .                TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT,
  1121.      .                TRAC(IPOS3),NTRAC,
  1122.      .                SIGF,VARF,DEFP,KERRE)
  1123.         END IF
  1124.       END IF
  1125.       RETURN
  1126. C
  1127. C======================================================================
  1128. C     MODELE PLASTIQUE JOINT_COAT
  1129. C======================================================================
  1130.   419 CONTINUE
  1131. C
  1132. C     ON RECUPERE LA COURBE DE SHEAR
  1133. C
  1134. C Note: La courbe a maintenant l'indices 4 alors que c'est
  1135. C       2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1136. C       'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...)
  1137. C
  1138.       IPOS1=1
  1139.       CALL COTRAJ(wrk52,wrk53,WRK2,4,IPOS1,1, NPOINT)
  1140.       NTRAS=NPOINT/2
  1141. C
  1142.       IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1143.         IF(KERRE.EQ.0) THEN
  1144. C
  1145.           CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS,
  1146.      .                SIGF,VARF,DEFP,KERRE)
  1147.         END IF
  1148.       ELSEIF(IFOUR.EQ.2)THEN
  1149.         IF(KERRE.EQ.0) THEN
  1150.         END IF
  1151.       END IF
  1152.       RETURN
  1153. C
  1154. C======================================================================
  1155. C     MODELE ENDOMMAGEABLE DAMAGE_TC
  1156. C======================================================================
  1157.   425 CONTINUE
  1158.       IF(MFR.EQ.1)THEN
  1159.         CALL DAMATC(IFOUR,XMAT,DDHOOK,LHOOK,SIG0,VAR0,
  1160.      &        DEPST,DSIGT,EPST0,EPIN0,      SIGF,VARF,DEFP,
  1161.      &        XMAT0,DDAUX)
  1162.       ENDIF
  1163.       RETURN
  1164. C
  1165. C======================================================================
  1166. C     MODELE PLASTIQUE_ENDOM ENDO_PLAS
  1167. C======================================================================
  1168.   435 CONTINUE
  1169.       CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0,
  1170.      &             SIGF,DEPST,NSTRS,KERRE,ISTEP)
  1171.       RETURN
  1172. C
  1173. C======================================================================
  1174. C     MODELE PLASTIQUE MUR_SHEAR (DEBRANCHE)
  1175. C======================================================================
  1176.   426 CONTINUE
  1177. C
  1178. C    POUR LE MOMENT, ELEMENT DE POUTRE
  1179. C    MAIS ON AJOUTE MAINTENANT LE MACRO ELEMENT
  1180. C
  1181.       IF(MFR.EQ.7.OR.MFR.EQ.61)THEN
  1182. C
  1183. C     ON RECUPERE LES COURBES
  1184. C
  1185. C Note: Les courbes ont maintenant les indices 5 a 10 alors que
  1186. C       c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a
  1187. C       incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso
  1188. C
  1189.         IPOS1=1
  1190.         CALL COTRAJ(wrk52,wrk53,WRK2, 5,IPOS1,0, NPOINT)
  1191.         NCURFP=NPOINT/2
  1192.         IPOS2=IPOS1+NPOINT
  1193.         CALL COTRAJ(wrk52,wrk53,WRK2, 6,IPOS2,0, NPOINT)
  1194.         NCURKP=NPOINT/2
  1195.         IPOS3=IPOS2+NPOINT
  1196.         CALL COTRAJ(wrk52,wrk53,WRK2, 7,IPOS3,0, NPOINT)
  1197.         NCURLP=NPOINT/2
  1198.         IPOS4=IPOS3+NPOINT
  1199.         CALL COTRAJ(wrk52,wrk53,WRK2, 8,IPOS4,0, NPOINT)
  1200.         NCURFM=NPOINT/2
  1201.         IPOS5=IPOS4+NPOINT
  1202.         CALL COTRAJ(wrk52,wrk53,WRK2, 9,IPOS5,0, NPOINT)
  1203.         NCURKM=NPOINT/2
  1204.         IPOS6=IPOS5+NPOINT
  1205.         CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS6,0, NPOINT)
  1206.         NCURLM=NPOINT/2
  1207. C
  1208.         IF(KERRE.EQ.0) THEN
  1209. C+PPM
  1210.           IF(MFR.EQ.7)THEN
  1211. C+PPM
  1212.             CALL   MSHETI(wrk52,wrk53,WRK2,
  1213.      >                  NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1214.      >                  IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6,
  1215.      >                  KERR2)
  1216.                  KERRE = KERR2
  1217. C+PPM
  1218.           ELSE
  1219.             IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1220. CCC                   CALL   MASHEJ(wrk52,wrk53,WRK2,
  1221. CCC     >                    NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1222. CCC     >                    IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6)
  1223.             ELSE
  1224.               KERRE=99
  1225.             ENDIF
  1226.           ENDIF
  1227. C+PPM
  1228.         END IF
  1229.       END IF
  1230.       RETURN
  1231. C
  1232. C======================================================================
  1233. C     MODELE PLASTIQUE ANCRAGE_ELIGEHAUSEN
  1234. C======================================================================
  1235.   391 CONTINUE
  1236.       IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1237.         CALL ANCREL(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  1238.       ENDIF
  1239.       RETURN
  1240. C
  1241. C======================================================================
  1242. C     MODELE PLASTIQUE BILI_MOMY
  1243. C======================================================================
  1244.   357 CONTINUE
  1245.       KERRE=0
  1246.       CALL BILIPO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1247.       RETURN
  1248. C
  1249. C======================================================================
  1250. C     MODELE PLASTIQUE BILI_EFFZ
  1251. C======================================================================
  1252.   358 CONTINUE
  1253.       KERRE=0
  1254.       CALL BILIFO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1255.       RETURN
  1256. C
  1257. C======================================================================
  1258. C     MODELE PLASTIQUE TAKEMO_MOMY
  1259. C======================================================================
  1260.   359 CONTINUE
  1261. C
  1262. C     ON RECUPERE LES COURBES MOMENT-COURBURE
  1263. C
  1264.       nccor=ncourb
  1265.       CALL COTRAF(wrk52,wrk53,WRK2,NCcOR)
  1266.       ncourb=nccor
  1267.       IF (KERRE.EQ.0) THEN
  1268. C
  1269.         IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1270.           CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1271.      &                NCOURB,SIGF,VARF,DEFP,KERRE)
  1272.         ELSE
  1273.           CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1274.      &                NCOURB,SIGF,VARF,DEFP,KERRE)
  1275.         ENDIF
  1276.       ENDIF
  1277.       RETURN
  1278. C
  1279. C======================================================================
  1280. C     MODELE PLASTIQUE BA1D
  1281. C======================================================================
  1282.   447 CONTINUE
  1283.       CALL BA1D(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1284.      &                  NCOURB,SIGF,VARF,DEFP,KERRE)
  1285.  
  1286.       RETURN
  1287. C
  1288. C======================================================================
  1289. C     MODELE PLASTIQUE TAKEMO_EFFZ
  1290. C======================================================================
  1291.   360 CONTINUE
  1292. C
  1293. C     ON RECUPERE LES COURBES MOMENT-COURBURE
  1294. C
  1295.       nccor=ncourb
  1296.       CALL COTRAF(wrk52,wrk53,WRK2,NCcor)
  1297.       ncourb=nccor
  1298.       IF (KERRE.EQ.0) THEN
  1299. C
  1300.         IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1301.           CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1302.      &                NCOURB,SIGF,VARF,DEFP,KERRE)
  1303.         ELSE
  1304.           CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1305.      &                NCOURB,SIGF,VARF,DEFP,KERRE)
  1306.         ENDIF
  1307. C
  1308.       ENDIF
  1309.       RETURN
  1310. C
  1311. C======================================================================
  1312. C     MODELE PLASTIQUE DRUCKER_PRAGER2
  1313. C======================================================================
  1314.   440 CONTINUE
  1315.       XLCARA=0.D0
  1316.       NEXO = EXOVA0(/1)
  1317.       DO INEX=1,NEXO
  1318.         IF ((NOMEXO(INEX)(1:4)     .EQ.'LCAR').AND.
  1319.      &      (CONEXO(INEX)(1:LCONMO).EQ.CONM(1:LCONMO))) THEN
  1320.           XLCARA=EXOVA0(INEX)
  1321.         ENDIF
  1322.       ENDDO
  1323.       CALL DRUCK2(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVALMA,
  1324.      &           NMATT,XCARB,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  1325.      &           IB,IGAU,IFORB,XLCARA,MELE)
  1326.       RETURN
  1327. C
  1328. C======================================================================
  1329. C     MODELE ENDOMMAGEABLE FATSIN
  1330. C======================================================================
  1331.   441 CONTINUE
  1332.  
  1333. *     Fatigue damage model   (fatsin)
  1334. *            print*,'appel a cfattt dans coml8'
  1335.       CALL CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou)
  1336.       RETURN
  1337. C
  1338. C======================================================================
  1339. C     MODELE PLASTIQUE BETON_INSA
  1340. C======================================================================
  1341.   366 CONTINUE
  1342. C
  1343. C  modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES,
  1344. C               DEFORMATION PLANES ET AXISYMETRIE
  1345. C
  1346.       nstrbi=iecou.nstrss
  1347.       iwpoi1=wrk12
  1348.       CALL BEINSA(SIG0,NSTRbi,DEPST,VAR0,XMAT,ivalma,NMATT,SIGF,VARF,
  1349.      1            KERRE,MELE,IFORB,NVARI,xcarb,NCARR,MFRbi,EPIN0,
  1350.      2            EPINF,DT,XE,NBNNbi,CMATE,IB,IGAU,iwpoi1)
  1351.       RETURN
  1352. C
  1353. C======================================================================
  1354. C     MODELE PLASTIQUE ECROUIS_DECOU
  1355. C======================================================================
  1356.   367 CONTINUE
  1357. C
  1358. C  modele ECROUIS_INSA  (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE)
  1359. C
  1360.       MVEL1= nint(XMAT(NMATR) )
  1361.       nccor=ncourb
  1362.       CALL CCOTRO(wrk52,wrk53,WRK2,nccor,MVEL1)
  1363.       ncourb=nccor
  1364.       LT1=NCOURB*2
  1365.       CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1366.      &              LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFORB)
  1367.       RETURN
  1368. C
  1369. C======================================================================
  1370. C     MODELE PLASTIQUE PARFAIT_DECOU
  1371. C======================================================================
  1372.   368 CONTINUE
  1373. C
  1374. C modele  PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE)
  1375. C
  1376.       NCOURB=3
  1377.       KERRE = 0
  1378.       TRAC(1)=0.D0
  1379.       TRAC(2)=0.D0
  1380.       TRAC(3)=XMAT(NMATR)
  1381.       TRAC(4)=XMAT(NMATR)/XMAT(1)
  1382.       TRAC(5)=XMAT(NMATR)
  1383.       TRAC(6)=1.D0
  1384.       IF (XMAT(NMATR).EQ.0.D0) KERRE = 33
  1385.       LT1=NCOURB*2
  1386.       CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1387.      &            LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFORB)
  1388.       RETURN
  1389. C
  1390. C======================================================================
  1391. C     MODELE PLASTIQUE ALONSO
  1392. C======================================================================
  1393.   369 CONTINUE
  1394. C
  1395. C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO
  1396. C
  1397. ****************************
  1398. *    SPECIAL SUCCION
  1399. *
  1400.       CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1401.      &           VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2)
  1402.       IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1403.         KERR1=1
  1404.       ENDIF
  1405.       RETURN
  1406. C
  1407. C======================================================================
  1408. C     MODELE PLASTIQUE PAKZAD
  1409. C======================================================================
  1410.   371 CONTINUE
  1411. C
  1412. C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD
  1413. C
  1414.       CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1415.      &            VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2)
  1416.       IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1417.         KERR1=1
  1418.       ENDIF
  1419.       RETURN
  1420. C
  1421. C======================================================================
  1422. C     MODELE PLASTIQUE INFILL_UNI
  1423. C======================================================================
  1424.   372 CONTINUE
  1425.       IF (MFRbi.EQ.27) THEN
  1426. C
  1427. C     ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1428. C
  1429.         CALL COTRAJ(wrk52,wrk53,WRK2,12,1,0, NPOINT)
  1430.         necou.NCOURB=NPOINT/2
  1431.         IF (KERRE.EQ.0) THEN
  1432.           nccor=necou.ncourb
  1433.           CALL CINFIL(wrk52,wrk53,wrk54,WRK2,nccor)
  1434.           necou.ncourb=nccor
  1435.         ENDIF
  1436.       ELSE
  1437.         KERRE = 99
  1438.       ENDIF
  1439.       RETURN
  1440. C
  1441. C======================================================================
  1442. C     MODELE PLASTIQUE CISAIL_NL
  1443. C======================================================================
  1444.   373 CONTINUE
  1445. C
  1446. C         MODELE ETAGE
  1447. C         pour le moment, element de barre
  1448. *
  1449.       IF (MFRbi.EQ.7) THEN
  1450. C
  1451. C     ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1452. C
  1453.         IPOS1=1
  1454.         CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1455.         NTRAP=NPOINT/2
  1456.         IPOS2=IPOS1+NPOINT
  1457.         CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1458.         NTRAN=NPOINT/2
  1459.         IF (KERRE.EQ.0) THEN
  1460.           CALL CETAG(wrk52,wrk53,wrk54,WRK2,NTRAP,NTRAN)
  1461.         ENDIF
  1462.       ELSE
  1463.         KERRE = 99
  1464.       ENDIF
  1465.       RETURN
  1466. C
  1467. C======================================================================
  1468. C     MODELE FLUAGE CERAMIQUE
  1469. C======================================================================
  1470. *---------------------------------------------------------------------
  1471. *           ceramique caroline, couplage gatt_monerie ottosen,
  1472. *           maxwell, couplage maxwell ottosen
  1473. *---------------------------------------------------------------------
  1474.   365 CONTINUE
  1475. *
  1476.       IF ((MFRbi.EQ.1).AND.(IFOMOD.EQ.2)) THEN
  1477.         IBIDO = 19
  1478.       ELSE
  1479.         IBIDO = 14
  1480.       ENDIF
  1481. *
  1482. * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION
  1483. * CAD LORSQUE TTRAN = 0
  1484. *
  1485.       IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN
  1486. *
  1487. * si le point de gauss est déjà endommagé par endommagement généralisé
  1488. * on le traite simplement par ccerac
  1489. *
  1490.         IF (VAR0(NVARI-1).EQ.1) THEN
  1491.           CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1492.      1        NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1493.           IND=1
  1494.         ELSE
  1495. *
  1496. * si le point de gauss n'a pas un endommagement généralisé
  1497. * on regarde si il a été fissuré
  1498. * par ottosen et si non on applique le fluage puis ottosen
  1499. * si oui on le traite par ottosen
  1500. *
  1501.           CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1502.           IF (ITOTO.EQ.0) THEN
  1503.             CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1504.      1       NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1505.             IND=1
  1506. * Ligne suivante à supprimer
  1507. * IF (IND.EQ.0) THEN
  1508. * on regarde si on a eu endommagement généralisé
  1509. * si on n'a pas eu endommagement généralisé on appelle ottosen
  1510.             IF (VARF(NVARI-1).NE.1) THEN
  1511.               DO 161 I = 1,NVARI
  1512.                 VAR01(I) = VARF(I)
  1513.  161          CONTINUE
  1514.               DO 835 I=1,NSTRS
  1515. *               PRINT *,'DEPST EPINF-EPIN0 ',
  1516. *     1         I,DEPST(I),(EPINF(I)-EPIN0(I))
  1517.                 DEPST(I) = DEPST(I) - (EPINF(I)-EPIN0(I))
  1518. C on remplace SIGF par SIG0
  1519.                 SIG01(I) = SIG0(I)
  1520.   835         CONTINUE
  1521.               CALL OTTOSE(JNPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,
  1522.      1                    ivalma,NMATT,xcarb,ICARA,NVARI,SIGF,VARF,
  1523.      2                    DEFP,MFR1,KERRE,IB,IGAU)
  1524. C on met à jour la variable interne EPSE commune aux deux modèles
  1525.               VARF(1) = VARF(1)+VARF(NVARI)
  1526. C             DO 537 I=1,NSTRS
  1527. C               IF (SIGF(I).NE.SIG01(I)) THEN
  1528. C                 PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I)
  1529. C               ENDIF
  1530. C537          CONTINUE
  1531. C             DO 538 I=1,NVARI
  1532. C               IF (VARF(I).NE.VAR01(I)) THEN
  1533. C                 PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I)
  1534. C               ENDIF
  1535. C 538         CONTINUE
  1536.  
  1537. C on calcule l'increment de déformation du pas de temps
  1538.               DO 836 I=1,NSTRS
  1539. C               IF (DEFP(I).NE.0.)  PRINT *,'DEFP',DEFP(I)
  1540.                 DEFP(I) = DEFP(I)+(EPINF(I)-EPIN0(I))
  1541.   836         CONTINUE
  1542.               IND=0
  1543.             ENDIF
  1544.           ELSE
  1545.             CALL OTTOSE(JNPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1546.      1                  NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1547.      2                  KERRE,IB,IGAU)
  1548.             VARF(1) = VARF(1)+VARF(NVARI)
  1549.             IND=0
  1550.           ENDIF
  1551.         ENDIF
  1552. C
  1553.       ELSE
  1554. *
  1555. * CAS OU ON PREND EN COMPTE LA TEMPERATURE DE TRANSITION
  1556. *
  1557.         IF (TETA2.GE.XMAT(IBIDO)) THEN
  1558.           CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1559.           IF (ITOTO.EQ.0) THEN
  1560.             CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1561.      1        NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1562.             IND=1
  1563.           ELSE
  1564.             CALL OTTOSE(JNPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1565.      1                  NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1566.      2                  KERRE,IB,IGAU)
  1567.             VARF(1) = VARF(1)+VARF(NVARI)
  1568.             IND=0
  1569.           ENDIF
  1570.         ELSE
  1571.           IF (VAR0(NVARI-1).EQ.1) THEN
  1572.          CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1573.      1      NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1574.             IND=1
  1575.           ELSE
  1576.             CALL OTTOSE(JNPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1577.      1                    NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1578.      2                    KERRE,IB,IGAU)
  1579.             VARF(1) = VARF(1)+VARF(NVARI)
  1580.             IND=0
  1581.           ENDIF
  1582.         ENDIF
  1583.       ENDIF
  1584.       IF (MFR1.EQ.17) THEN
  1585.         IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  1586.           CALL ERREUR(KERREU1)
  1587.         ENDIF
  1588.       ENDIF
  1589. C
  1590.       DTOPTI  = MIN(DTOPTI,DTT)
  1591.       NINCMA = MAX(NINCMA,NSSINC)
  1592.       NCOMP = NCOMP + 1
  1593.       TSOM = TSOM + DTT
  1594.       NSOM = NSOM + NSSINC
  1595.       NINV = NINV + INV
  1596.       TCAR = TCAR + DTT* DTT
  1597.       IF (KERRE.NE.0.AND.KERRE.NE.99) THEN
  1598.         KERR1=1
  1599.       ENDIF
  1600.       RETURN
  1601. C
  1602. C======================================================================
  1603. C     MODELE VISCOPLASTIQUE UO2
  1604. C======================================================================
  1605.   408 CONTINUE
  1606. C
  1607.       IND=0
  1608.       FI1 = 0.D0
  1609.       FI2 = 0.D0
  1610.       nexo = exova0(/1)
  1611.       do 2050 inex = 1,nexo
  1612.         if ((nomexo(inex)(1:4).eq.'DFIS').and.
  1613.      &      (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  1614.           fi1 = exova0(inex)
  1615.           fi2 = exova1(inex)
  1616.           goto 2001
  1617.         endif
  1618.  2050 continue
  1619.  2001 continue
  1620. C
  1621. C NSIMP pointe sur la caracteristique de fissuration facult. qui
  1622. C                indique le type de resolution souhaite
  1623. C
  1624.       IF (IFOMOD.EQ.2.AND.MFR1.EQ.1) THEN
  1625.         NSIMP=71
  1626.       ELSE
  1627.         NSIMP=66
  1628.         IF(MFR1.EQ.1.AND.IFOUR.EQ.-2)   NSIMP=62
  1629.         IF(MFR1.EQ.3.OR.MFR1.EQ.9)      NSIMP=61
  1630.       ENDIF
  1631.       XSIMP=XMAT(NSIMP)
  1632. C
  1633.       IF (XSIMP.EQ.0.D0) THEN
  1634. C resolution complete
  1635. C
  1636.         CALL UO2OTO(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1637.      1              XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1638.      2              DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1639.       ELSE
  1640. C resolution simplifiee
  1641. C
  1642.          CALL UO2OT2(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1643.      1               XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1644.      2               DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1645.       ENDIF
  1646.       IF (KERRE.NE.0.AND.KERRE.NE.99) KERR1=1
  1647.       RETURN
  1648. C
  1649. C======================================================================
  1650. C     MODELE FLUAGE MAXWELL
  1651. C======================================================================
  1652.   374 CONTINUE
  1653. *
  1654. *                   CHAINE DE MAXWELL
  1655. *
  1656. *     on commence par recuperer le nombre d'elements dans la chaine
  1657. *     et les proprietes et variables internes associees a des objets
  1658. *
  1659.       nbgmab=nbgmat
  1660.       nlmatb=nelmat
  1661.       CALL CMAXTA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMbT,NLMATb,NWA,
  1662.      &              NCHAIN)
  1663.       nbgmat=nbgmab
  1664.       nelmat=nlmatb
  1665.       IF (IERR.NE.0) THEN
  1666.         SEGSUP WR12
  1667.         return
  1668.       ENDIF
  1669. C
  1670.       IF (MFRbi.EQ.3.OR.MFRbi.EQ.39) THEN
  1671.         dtbi=dt
  1672.         CALL CMAXGE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1673.         dt=dtbi
  1674.       ELSE
  1675. C
  1676. *
  1677. *         MLR 10/08/99
  1678. *
  1679. *         ON PASSE LE SEGMENT DE TRAVAIL WTRAV
  1680.         dtbi=dt
  1681.         CALL CMAXWE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1682.         dt=dtbi
  1683.       ENDIF
  1684. *
  1685. *      ici gerer les erreurs
  1686. *
  1687.       CALL CMAXTB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN)
  1688. C     SEGSUP WR12
  1689.       RETURN
  1690. C
  1691. C======================================================================
  1692. C     MODELE FLUAGE MAXOTT
  1693. C======================================================================
  1694.   406 CONTINUE
  1695. *
  1696. * on commence par recuperer le nombre d'elements dans la chaine
  1697. * et les proprietes et variables internes associees a des objets
  1698. *
  1699.       nbgmab=nbgmat
  1700.       nlmatb=nelmat
  1701.       CALL CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAb,NLMATb,NWA,
  1702.      &              NCHAIN,EPSFLU)
  1703.       nbgmat=nbgmab
  1704.       nelmat=nlmatb
  1705.       IF (IERR.NE.0) THEN
  1706.         SEGSUP WR12
  1707.         RETURN
  1708.       ENDIF
  1709. *
  1710. * modele maxott
  1711. *
  1712.       dtbi=dt
  1713.       CALL CMAXOT(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA,
  1714.      &              EPSFLU)
  1715.       dt=dtbi
  1716. *
  1717. * stockage des variables internes et des proprietes
  1718. *
  1719.       CALL CMAXOB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN,EPSFLU)
  1720. C     SEGSUP WR12
  1721.       RETURN
  1722. C
  1723. C======================================================================
  1724. C     MODELES FLUAGE FBB1 ET FBB2
  1725. C======================================================================
  1726.   427 CONTINUE
  1727.   428 CONTINUE
  1728.       CALL CFBB(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1729.       RETURN
  1730. C
  1731. C======================================================================
  1732. C     MODELE PLASTIQUE INCO
  1733. C======================================================================
  1734.   429 CONTINUE
  1735.       CALL INCO(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1736.       RETURN
  1737. C
  1738. C======================================================================
  1739. C     MODELE FLUAGE KELVIN
  1740. C======================================================================
  1741.   474 CONTINUE
  1742.       CALL KELVIN (wrk52,wrk53,wrk54,IB,IGAU,NBPGAU)
  1743.       RETURN
  1744. C
  1745. C======================================================================
  1746. C     MODELE VISCOPLASTIQUE FLUTRA
  1747. C======================================================================
  1748.  443  CONTINUE
  1749.       NMATER = NMATT + 3
  1750.       LWTRA = NMATER + (8*NSTRS) + (3*NSTRS*NSTRS)
  1751.       IF(LW.LT.LWTRA) THEN
  1752.         LW = LWTRA
  1753.         SEGADJ WRK3
  1754.       ENDIF
  1755. *
  1756.       LA1  = 1
  1757.       LA2  = LA1  + NMATER
  1758.       LA3  = LA2  + NSTRS
  1759.       LA4  = LA3  + NSTRS
  1760.       LA5  = LA4  + NSTRS
  1761.       LA6  = LA5  + NSTRS*NSTRS
  1762.       LA7  = LA6  + NSTRS
  1763.       LA8  = LA7  + NSTRS
  1764.       LA9  = LA8  + NSTRS
  1765.       LA10 = LA9  + NSTRS
  1766.       LA11 = LA10 + NSTRS
  1767.       LA12 = LA11 + NSTRS*NSTRS
  1768. *
  1769.       CALL FLUTRA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NMATT,
  1770.      &            IFOUR,DT,IB,IGAU,TETA1,TETA2,ITHER,NMATER,
  1771.      &            SIGF,VARF,WORK(LA1),WORK(LA2),WORK(LA3),
  1772.      &            WORK(LA4),WORK(LA5),WORK(LA6),WORK(LA7),
  1773.      &            WORK(LA8),WORK(LA9),WORK(LA10),WORK(LA11),
  1774.      &            WORK(LA12),KERRE)
  1775.       RETURN
  1776. C
  1777. C======================================================================
  1778. C     MODELE PLASTIQUE BILIN_EFFX
  1779. C======================================================================
  1780.  450  CONTINUE
  1781.       KERRE=0
  1782.       CALL BREVA1(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1783.       RETURN
  1784. C
  1785. C======================================================================
  1786. C     MODELE PLASTIQUE ISS_GRANGE
  1787. C======================================================================
  1788.  451  CONTINUE
  1789.       KERRE=0
  1790.       CALL ISSGRA(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1791.       IF (KERRE.EQ.22) THEN
  1792.         INTERR(1)=IB
  1793.         MOTERR(1:4) = 'JOI1'
  1794.         INTERR(2)=IGAU
  1795.         INTERR(3)=JNPLAS
  1796.         CALL ERREUR(268)
  1797.       ENDIF
  1798.       IF (KERRE.EQ.23) THEN
  1799.         CALL ERREUR(1016)
  1800.       ENDIF
  1801.       IF (KERRE.EQ.25) THEN
  1802.         CALL ERREUR(1017)
  1803.       ENDIF
  1804.       RETURN
  1805. C
  1806. C======================================================================
  1807. C     MODELE PLASTIQUE RUP_THER
  1808. C======================================================================
  1809.  452  CONTINUE
  1810.       KERRE=0
  1811.       CALL RUPTHE(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1812.       IF (KERRE.EQ.22) THEN
  1813.         INTERR(1)=IB
  1814.         MOTERR(1:4) = 'JOI1'
  1815.         INTERR(2)=IGAU
  1816.         INTERR(3)=JNPLAS
  1817.         CALL ERREUR(268)
  1818.       ENDIF
  1819.       RETURN
  1820. C
  1821. C======================================================================
  1822. C     MODELE PLASTIQUE GERNAY
  1823. C======================================================================
  1824.  455  CONTINUE
  1825.       KERRE=0
  1826.       CALL GERNAY(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU)
  1827.       RETURN
  1828. C
  1829. C======================================================================
  1830. C     MODELE PLASTIQUE WELLS
  1831. C======================================================================
  1832.  456  CONTINUE
  1833.       CALL WELLS(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU)
  1834.       RETURN
  1835. C
  1836. C======================================================================
  1837. C     MODELE ELASTIQUE NON_LINEAIRE UTILISATEUR
  1838. C======================================================================
  1839. C        Modele 'NON_LINEAIRE' 'UTILISATEUR' : integrateur externe
  1840. C        specifique UMAT
  1841. C-----------------------------------------------------------------------
  1842.   899 CONTINUE
  1843. C
  1844.       KERR1 = 0
  1845. C
  1846. C     Pointeur (>0) sur fonction externe si definie
  1847.       m_ptre = wrk53.jecher
  1848. C
  1849. C     Preparation des entrees de la routine UMAT
  1850. C     N.B. Les arguments pointeurs sont reperes par des
  1851. C          caracteres minuscules
  1852. C
  1853.       CALL WKUMA1 ( wrk52, wkumat )
  1854. C
  1855. C     Integration de la loi externe au point courant
  1856. C     N.B. Les entrees/sorties non actives ou non exploitees sont
  1857. C         reperees par des caracteres minuscules
  1858. C
  1859.       IF (m_ptre.LE.0) THEN
  1860. C
  1861. C       Appel a UMAT standard de Cast3M
  1862.         CALL UMAT ( SIGF, VARF, ddsdde, sse, spd, scd,
  1863.      &              rpl, ddsddt, drplde, drpldt,
  1864.      &              EPST0, DEPST, TIME, DTIME,
  1865.      &              TEMP, DTEMP, PAREX0, DPRED,
  1866.      &              CMNAME, ndi, nshr, NSIG0, NSTATV,
  1867.      &              XMATF, NPROPS, COORGA,
  1868.      &              DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  1869.      &              IB, IGAU, layer, kspt, kstep, KINC )
  1870. C
  1871.       ELSE
  1872. C
  1873. C       Branchement a la loi externe pointee par m_ptre
  1874.         CALL UMATEXT ( m_ptre,
  1875.      &                 SIGF, VARF, ddsdde, sse, spd, scd,
  1876.      &                 rpl, ddsddt, drplde, drpldt,
  1877.      &                 EPST0, DEPST, TIME, DTIME,
  1878.      &                 TEMP, DTEMP, PAREX0, DPRED,
  1879.      &                 CMNAME, ndi, nshr, NSIG0, NSTATV,
  1880.      &                 XMATF, NPROPS, COORGA,
  1881.      &                 DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  1882.      &                 IB, IGAU, layer, kspt, kstep, KINC )
  1883. C
  1884.       ENDIF
  1885. C
  1886.       IF (KINC.NE.1) THEN
  1887.         IF (KINC.EQ.0) THEN
  1888.           ISIGN = 1
  1889.         ELSE
  1890.           ISIGN = ABS(KINC)/KINC
  1891.         ENDIF
  1892.         KERRE = ISIGN*92
  1893.         KERR1 = -1-ABS(KINC)
  1894.       ENDIF
  1895. C
  1896. C     Releve du pas de temps optimal pour l'iteration suivante
  1897. C
  1898.       DTOPTI=PNEWDT*DTIME
  1899.  
  1900.       RETURN
  1901. C
  1902. C======================================================================
  1903. C     MODELE ELASTIQUE NON_LINEAIRE EQUIPLAS
  1904. C======================================================================
  1905. C-----------------------------------------------------------------------
  1906. C        Modeles 'VISCO_EXTERNE' : integres par CCREEP
  1907. C-----------------------------------------------------------------------
  1908.   898 CONTINUE
  1909. C
  1910.       KERR1 = 0
  1911. C
  1912. C     Pointeur (>0) sur fonction externe si definie
  1913.       m_ptre = wrk53.jecher
  1914. C
  1915.       IF (m_ptre.LE.0) THEN
  1916. C
  1917. C       Appel a CCREEP standard de Cast3M
  1918.         CALL CCREEP ( wrk52, wrk53, wrk54,
  1919.      &                IFORB, IB, IGAU, NBPGAU,
  1920.      &                wcreep, iecou, xecou )
  1921. C
  1922.       ELSE
  1923. C
  1924. C       Branchement a la loi externe pointee par m_ptre
  1925. C*      CALL EXTLOI(m_ptre,...)
  1926.         KSTEPC = 251
  1927. C*TMP Option non disponible pour l'instant (cf. modeli.eso)
  1928. C
  1929.       ENDIF
  1930.  
  1931. C     Erreur detectee par l'integrateur CCREEP
  1932. C
  1933.       IF (KERRE.NE.0) THEN
  1934.         KERR1 = 1
  1935.         RETURN
  1936.       ENDIF
  1937. C
  1938. C     Erreur lors d'un appel au module utilisateur CREEP
  1939. C
  1940.       IF (KSTEPC.NE.1) THEN
  1941.         IF (KSTEPC.EQ.0) THEN
  1942.           ISIGN = 1
  1943.         ELSE
  1944.           ISIGN = ABS(KSTEPC)/KSTEPC
  1945.         ENDIF
  1946.         KERRE = ISIGN*93
  1947.         KERR1 = -1-ABS(KSTEPC)
  1948.       ENDIF
  1949.       RETURN
  1950. C
  1951. C======================================================================
  1952.       END
  1953.  
  1954.  
  1955.  

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