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

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