Télécharger la plaquette Cast3M


fr en

Télécharger coml8.eso

Retour à la liste

Numérotation des lignes : 

coml8

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

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