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

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