Télécharger la plaquette Cast3M


fr en

Télécharger coml7.eso

Retour à la liste

Numérotation des lignes : 

  1. C COML7     SOURCE    BP208322  17/03/01    21:16:20     9325           
  2.       SUBROUTINE COML7(iqmod,wrk52,wrk53,wrk54,IB,igau,
  3.      & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  4.      & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou)
  5.  
  6. *-----------------------------------------------------------------------
  7. * lois locales  en MECANIQUE et POREUX
  8. *  decrites au point d integration
  9. *-----------------------------------------------------------------------
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12. -INC CCOPTIO
  13. -INC CCGEOME
  14. -INC SMLREEL
  15. -INC SMMODEL
  16. -INC SMELEME
  17. -INC SMINTE
  18. -INC CCHAMP
  19. -INC SMCOORD
  20. * segment deroulant le mcheml
  21. -INC DECHE
  22. *
  23.       SEGMENT WRK2
  24.         REAL*8 TRAC(LTRAC)
  25.       ENDSEGMENT
  26. *
  27.       SEGMENT WRK3
  28.         REAL*8 WORK(LW),WORK2(LW2)
  29.       ENDSEGMENT
  30. *
  31.       SEGMENT MWRKXE
  32.         REAL*8 XE(3,NBNN)
  33.       ENDSEGMENT
  34. *
  35.       SEGMENT WRK6
  36.         REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  37.         REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  38.         REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  39.       ENDSEGMENT
  40. *
  41.       SEGMENT WRK7
  42.         REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  43.       ENDSEGMENT
  44. *
  45.       SEGMENT WRK8
  46.         REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  47.         REAL*8 DDINVp(NSTRS,NSTRS)
  48.       ENDSEGMENT
  49. *
  50.       SEGMENT WRK9
  51.         REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  52.         REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  53.         REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  54.         REAL*8 SIGY(NSIGY)
  55.         INTEGER NKX(NNKX)
  56.       ENDSEGMENT
  57. *
  58.       SEGMENT WRK91
  59.         REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  60.         REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  61.         REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  62.         REAL*8 SIGY1(NSIGY1)
  63.       ENDSEGMENT
  64. *
  65.       SEGMENT WR10
  66.         INTEGER IABLO1(NTABO1)
  67.         REAL*8  TABLO2(NTABO2)
  68.       ENDSEGMENT
  69. *
  70.       SEGMENT WR11
  71.         INTEGER IABLO3(NTABO3)
  72.         REAL*8  TABLO4(NTABO4)
  73.       ENDSEGMENT
  74. *
  75. c mistral :
  76.       SEGMENT WR13
  77.         REAL*8 PDILT(NPDILT),PNBRE(NPNBRE),PCOHI(NPCOHI),PECOU(NPECOU)
  78.         REAL*8 PEDIR(NPEDIR),PRVCE(NPRVCE),PECRX(NPECRX),PDVDI(NPDVDI)
  79.         REAL*8 PCROI(NPCROI)
  80.         REAL*8 PINCR(NPINCR)
  81.       ENDSEGMENT
  82. *
  83.       segment wrk12
  84.        real*8  bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  85.        real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  86.        real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  87.        real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  88.        real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  89.        real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  90.        real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  91.        integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  92.        integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  93.       endsegment
  94. *
  95.       segment wrkgur
  96.        real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7
  97.        real*8  wgur8,wgur9,wgur10,wgur11,wgur12(6)
  98.        real*8 wgur13(7), wgur14
  99.        real*8 wgur15,wgur16,wgur17
  100.       endsegment
  101. C
  102. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  103. C l'integrateur externe specifique UMAT
  104. C
  105.       SEGMENT WKUMAT
  106. C        Entrees/sorties de la routine UMAT
  107.          REAL*8        DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  108.      &                 RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  109.      &                 TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  110.      &                 DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  111.          CHARACTER*16  CMNAME
  112.          INTEGER       NDI, NSHR, NSTATV, NPROPS,
  113.      &                 LAYER, KSPT, KSTEP, KINC
  114. C        Variables de travail
  115.          LOGICAL       LTEMP, LPRED, LVARI, LDFGRD
  116.          INTEGER       NSIG0, NPARE0, NGRAD0
  117.       ENDSEGMENT
  118. C
  119. C Segment de travail pour les lois 'VISCO_EXTERNE'
  120. C
  121.       SEGMENT WCREEP
  122. C        Entrees/sorties constantes de la routine CREEP
  123.          REAL*8        SERD
  124.          CHARACTER*16  CMNAMC
  125.          INTEGER       LEXIMP, NSTTVC, LAYERC, KSPTC
  126. C        Entrees/sorties de la routine CREEP pouvant varier
  127.          REAL*8        STV(NSTV),    STV1(NSTV),  STVP1(NSTV),
  128.      &                 STVP2(NSTV),  STV12(NSTV), STVP3(NSTV),
  129.      &                 STVP4(NSTV),  STV13(NSTV), STVF(NSTV),
  130.      &                 TMP12,        TMP,         TMP32,
  131.      &                 DTMP12,       DTMP,
  132.      &                 PRD12(NPRD),  PRD(NPRD),   PRD32(NPRD),
  133.      &                 DPRD12(NPRD), DPRD(NPRD)
  134.          INTEGER       KSTEPC
  135. C        Autres indicateurs et variables de travail
  136.          LOGICAL       LTMP, LPRD, LSTV
  137.          INTEGER       IVIEX, NPAREC
  138.          REAL*8        dTMPdt, dPRDdt(NPRD)
  139.       ENDSEGMENT
  140. *
  141.       REAL*8 CRIGI(12),CMASS(12)
  142. *
  143. *  Segment ECOU: sert de fourre-tout pour les tableaux
  144. *
  145.       SEGMENT ECOU
  146.        REAL*8 TEST, ALFAH,
  147.      1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  148.      2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  149.      1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  150.      2 SIPLAD(6),DSIGP0(6),TET,TETI
  151.       ENDSEGMENT
  152. *
  153. *  Segment NECOU utilisé dans CCOINC
  154. *
  155.       SEGMENT NECOU
  156.        INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  157.      . ITYP,IFOURB,IFLUAG,
  158.      . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  159.      . JFLUAG,KFLUAG,LFLUAG,
  160.      . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  161.       ENDSEGMENT
  162. *
  163. *  Segment IECOU: sert de fourre-tout pour les initialisations
  164. *  d'entiers
  165. *
  166.       SEGMENT IECOU
  167.       INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  168.      .  NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  169.      .  NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  170.      .  IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  171.      .  MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  172.      .  KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  173.      .  NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  174.       ENDSEGMENT
  175. *
  176. *  Segment XECOU: sert de fourre-tout pour les initialisations
  177. *  de réels
  178. *
  179.       SEGMENT XECOU
  180.        REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  181.       ENDSEGMENT
  182. *
  183. *      moterr(1:6) = 'COML7  '
  184. *      moterr(7:15) = 'element '
  185. *      interr(1) = ib
  186. *      interr(2) = igau
  187. *      call erreur(-329)
  188.  
  189.       imodel = iqmod
  190.  
  191. *---------------------------------------------------------------------
  192. *                  ecoulement selon les modeles
  193. *---------------------------------------------------------------------
  194. c
  195.       NBPGAU = NBGS
  196.       NVARI  = NVART
  197. c
  198. *---------------------------------------------------------------------
  199. c      modele elastique lineaire
  200. *---------------------------------------------------------------------
  201.       IF (INPLAS.EQ.0)THEN
  202. * barres et poutres
  203.         IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN
  204.          IF (CMATE.EQ.'SECTION') THEN
  205.           IPM = int(xmat(1))
  206.           IPC = int(xmat(2))
  207.           MLREEL = NINT(XMAT(3))
  208.           IF(MLREEL.EQ.0)THEN
  209.             CALL FRIGIE(IPM,IPC,CRIGI,CMASS)
  210.           ELSE
  211.             SEGACT, MLREEL
  212.             CALL BIFLX1(PROG(1),NSTRS,CRIGI)
  213.             SEGDES, MLREEL
  214.           ENDIF
  215.          ENDIF
  216.         ENDIF
  217. c
  218.         CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  219.      1              MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,NPINT,NBGMAT,
  220.      2              NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,
  221.      3              DDHOMU,CRIGI,DSIGT,IRTD)
  222. *
  223.         IF(IRTD.EQ.1) THEN
  224.           DO 10 IC=1,NSTRSS
  225.             SIGF(IC)=SIG0(IC)+DSIGT(IC)
  226.  10       CONTINUE
  227. *
  228.            DO 20  IC=1,NVARI
  229.             VARF(IC)=VAR0(IC)
  230.  20       CONTINUE
  231.         ELSE
  232.           KERRE=69
  233.         ENDIF
  234.         RETURN
  235.       ENDIF
  236. c
  237. *---------------------------------------------------------------------
  238. c     modeles implantes dans ccoinc
  239. *---------------------------------------------------------------------
  240. * appel ccoin0 et ccoinc
  241. * mfr1 <- MFR , nstrss <- nstrs , wrk52 <- wrk0
  242. * CCOTRA <- COTRAC , xcarb <- XCAR
  243. *---------------------------------------------------------------------
  244. c
  245. c           1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  246.       GOTO(301,300,303,304,305,300,307,300,300,300,300,312,300,300,315,
  247.      $     300,317,300,319,320,321,322,323,324,325,300,300,300,300,300,
  248. *           31
  249.      $     300,300,300,300,300,300,300,300,300,300,300,300,343,344,345,
  250.      $     300,300,300,300,300,300,300,353,300,300,300,300,300,300,300,
  251. *           61
  252.      $     361,300,363,300,300,300,300,300,300,370,300,300,300,300,300,
  253.      $     376,377,300,300,300,300,382,300,384,385,386,387,300,300,390,
  254. *           91
  255.      $     300,300,300,394,395,300,300,300,300,400,401,402,403,900,405,
  256.      $     900,407,900,400,900,411,412,413,900,900,900,900,900,900,420,
  257. *          421
  258.      $     421,422,900,900,900,900,900,900,900,430,900,900,900,900,900,
  259.      $     436,437,438,439,900,900,900,900,900,900,900,900,900,900,900,
  260. *          451
  261.      $     900,900,900,900,900,900,900,900,900,900,900,900,900,900,900
  262.      $ ) INPLAS
  263.   300 continue
  264.   900 continue
  265.        write(ioimp,*) ' erreur d aiguillage coml7 '
  266.        call erreur(5)
  267.        return
  268.  
  269. *      ELSE IF ( INPLAS .EQ.  1 .OR. INPLAS .EQ.  3 .OR.
  270. *     2          INPLAS .EQ.  4 .OR. INPLAS .EQ.  5 .OR.
  271. *     3          INPLAS .EQ.  7 .OR. INPLAS .EQ. 12 .OR.
  272. *     4          INPLAS .EQ. 15 .OR. INPLAS .EQ. 87 ) THEN
  273. c
  274. c     modele von mises isotrope associe ( d'apres inca )
  275. c
  276. *        IF (INPLAS .EQ. 1) THEN
  277.  301  continue
  278. c
  279. c    cas de la plasticite parfaite
  280. c
  281.           NCOURB=2
  282.           IF (MATE.EQ.4.AND.MFRbi.EQ.1.AND.IDIM.EQ.3) THEN
  283.             TRAC(1)=XMAT(9)
  284.             TRAC(3)=XMAT(9)
  285.           ELSE
  286.             TRAC(1)=XMAT(5)
  287.             TRAC(3)=XMAT(5)
  288.           ENDIF
  289.           TRAC(2)=0.D0
  290.           TRAC(4)=1.D9
  291.           IF( (IDIM.EQ.2.AND.XMAT(5).EQ.0.D0).OR.
  292.      +        (MATE.EQ.4.AND.MFRbi.EQ.1.AND.IDIM.EQ.3.AND.
  293.      +         XMAT(9).EQ.0.D0)) THEN
  294.             KERRE = 33
  295.           ELSE
  296.             KERRE = 0
  297.           ENDIF
  298.           GO TO 800
  299. c
  300. *        ELSE IF (INPLAS .EQ. 3) THEN
  301.   303 continue
  302. c
  303. c    cas du modele de drucker-prager parfait
  304. c    les donnees sont les limites en traction et en compression
  305. c
  306.           IMAPLA=5
  307.           DEN =  ABS(XMAT(6)) + XMAT(5)
  308.           IF(DEN.EQ.0.D0) THEN
  309.             KERRE=48
  310.           ELSE
  311.             XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  312.             XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  313.             XMAT(6) = 1.D0
  314.             XMAT(8)=XMAT(5)
  315.             XMAT(9)=XMAT(6)
  316.             XMAT(10)=XMAT(5)
  317.             XMAT(11)=XMAT(6)
  318.             XMAT(12)=XMAT(7)
  319.             XMAT(13)=0.D0
  320. c
  321. c          petits tests sur les donnees
  322.             IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  323.      &          XMAT(5)*1.01/(XMAT(6)+1.D-20)
  324.      &         .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  325.                KERRE = 48
  326.             ELSE
  327.               KERRE = 0
  328.             ENDIF
  329.           ENDIF
  330.           GO TO 800
  331. c
  332. *        ELSE IF (INPLAS .EQ. 4) THEN
  333.   304 continue
  334. c
  335. c    cas de la plasticite cinematique bilineaire
  336. c
  337.           IF(XMAT(5).EQ.0.D0) THEN
  338.             KERRE=33
  339.           ELSE
  340.             ICINE=1
  341.             NCOURB=2
  342.             TRAC(1)=XMAT(5)
  343.             TRAC(2)=0.D0
  344.             TRAC(4)=1.D9
  345.             TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4)
  346.           ENDIF
  347.           GOTO 800
  348. c
  349. *        ELSE IF (INPLAS .EQ.  5 .OR.INPLAS.EQ.87) THEN
  350.   305 continue
  351.   387 continue
  352. c
  353. c   cas de la plasticite isotrope ecrouissable
  354. c
  355. c  on recupere la courbe de traction
  356. c
  357.       nccor=ncourb
  358.          CALL CCOTRA(WRK52,WRK2,NCcor,WRK53)
  359.       ncourb=nccor
  360.       GO TO 800
  361. c
  362.   307 continue
  363. *       ELSE IF (INPLAS .EQ.  7) THEN
  364. c
  365. c    cas du modele chaboche 1
  366. c
  367.          KERRE = 0
  368.          ICINE = 1
  369.          IMAPLA= 4
  370.          GO TO 800
  371. c
  372. *       ELSE IF (INPLAS .EQ.  12) THEN
  373.   312 continue
  374. c
  375. c    cas du modele chaboche 2
  376. c
  377.           KERRE = 0
  378.           ICINE = 1
  379.           IMAPLA= 4
  380.           GO TO 800
  381. c
  382. *        ELSE IF (INPLAS .EQ. 15) THEN
  383.   315 continue
  384. c
  385. c    cas du modele de drucker-prager general
  386. c
  387.           IMAPLA=5
  388. c
  389. c          petits tests sur les donnees
  390. c
  391.           IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  392.      1         XMAT(5)*1.01/(XMAT(6)+1.D-20)
  393.      2       .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  394.             KERRE = 48
  395.           ELSE
  396.             KERRE = 0
  397. c
  398. c          permutations pour ecoinc
  399. c
  400.             DO 30 I=5,7
  401.               WW=XMAT(I)
  402.               XMAT(I)=XMAT(I+5)
  403.               XMAT(I+5)=WW
  404.  30         CONTINUE
  405.           ENDIF
  406. c
  407. *        ENDIF
  408.  800  continue
  409.         IF (KERRE .NE. 0) RETURN
  410.           DO 40 IC=1,ICARA
  411.             WORK(IC)=XCARB(IC)
  412. 40        CONTINUE
  413.           BID(1)=0.D00
  414.           BID(2)=0.D00
  415.           BID(3)=0.D00
  416.  
  417.           IF ((INPLAS .EQ. 1  .OR.INPLAS .EQ. 4  .OR.
  418.      &         INPLAS .EQ. 5  .OR.INPLAS .EQ. 7  .OR.
  419.      &         INPLAS .EQ. 12.OR.INPLAS.EQ.87 ) .AND.
  420.      &         (MFRbi .EQ. 1 .OR. MFRbi .EQ. 3 .OR.
  421.      &          MFRbi .EQ. 5 .OR. MFRbi .EQ. 7 .OR.
  422.      &          MFRbi .EQ. 9 )     .AND.
  423.      &         (CMATE.NE.'UNIDIREC')) THEN
  424. c
  425.       nccor=ncourb
  426.       iforb=ifourb
  427.  
  428.         CALL CCOIN0(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  429.      &                  NBPGAU,NCcor,IFORB,iecou)
  430.       ncourb=nccor
  431.       ifourb=iforb
  432. c
  433.           ELSE
  434. c
  435.         CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  436.      &                  NBPGAU,ecou,necou,iecou)
  437. c
  438.           ENDIF
  439. c
  440.        RETURN
  441. *        ENDIF
  442. c
  443. C BCN
  444. C
  445. * MRS-Lade   (INPLAS=111)
  446. * J2         (INPLAS=112)
  447. * RH_COULOMB (INPLAS=113)
  448. *            ELSE IF (INPLAS.eq.111.or.INPLAS.eq.112.or.INPLAS.eq.113)
  449.   411  continue
  450.   412  continue
  451.   413 continue
  452. *     .      THEN
  453. c            calcula incremento de tensiones trial, DSIGT
  454.              call CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,
  455.      .                   N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,
  456.      .               NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  457.      .               XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  458.              nescri   =0
  459.              nues     =6
  460.              nitmax   =25
  461.              precis   =1.E-10
  462.              IF (INPLAS.eq.111) THEN
  463. c             MODELE MRS_LADE
  464. C              mrs-lade requiere siempre derivacion numerica
  465.                nnumer=3
  466.                deltax=2.D0**(int(log10(1.D-6)/log10(2.D0)))
  467.                call eco_MRSMAC(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  468.      .                         NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  469.      .                         nues,nnumer,deltax,kdummy)
  470.              ELSE IF (INPLAS.eq.112) THEN
  471. c              MODELE J2
  472.                call eco_j2(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  473.      .                     NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  474.      .                     nues,kdummy)
  475.              ELSE IF (INPLAS.eq.113) THEN
  476. c              Rounded Hyperbolic Mohr-Coulomb
  477.                call eco_rhmc(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  478.      .                       NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  479.      .                       nues,kdummy)
  480.              ENDIF
  481.              if (kerre.eq.1) then
  482. c                write(*,*)
  483. c     .          ' Nonconvergence c7 at elem: ', ib,' gauss:',igau
  484.                 kerre=99
  485.              endif
  486.             RETURN
  487. C
  488. C BCNc
  489. ***   ELSE
  490. *     KERRE = 99
  491. *      ENDIF
  492. *---------------------------------------------------------------------
  493. *     modeles de viscoplasticite integres par consti
  494. *---------------------------------------------------------------------
  495. *      IF ( INPLAS .EQ. 17 .OR.
  496. *     2     (INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR.
  497. *     3      INPLAS .EQ. 61 .OR. INPLAS .EQ. 63  .OR.
  498. *     4      INPLAS .EQ. 53 .OR. INPLAS .EQ. 102 .OR.
  499. *     5      INPLAS .EQ. 44 .OR. INPLAS .EQ. 76  .OR.
  500. *     6      INPLAS .EQ. 45 .OR. INPLAS .EQ. 77  .OR.
  501. *     7      INPLAS .EQ. 84 .OR. INPLAS .EQ. 85  .OR.
  502. *     8      INPLAS .EQ. 86 .OR. INPLAS .EQ. 70  .OR.
  503. *     9      INPLAS .EQ. 107 .OR. INPLAS .EQ. 130 .OR.
  504. *     a      INPLAS .EQ. 136 .OR. INPLAS .EQ. 137 .OR.
  505. *     b      INPLAS .EQ. 138 .OR. INPLAS .EQ. 139 ) THEN
  506.   317 continue
  507.   319 continue
  508.   320 continue
  509.   321 continue
  510.   322 continue
  511.   323 continue
  512.   324 continue
  513.   325 continue
  514.   344 continue
  515.   345 continue
  516.   353 continue
  517.   361 continue
  518.   363 continue
  519.   370 continue
  520.   376 continue
  521.   377 continue
  522.   384 continue
  523.   385 continue
  524.   386 continue
  525.   402 continue
  526.   407 continue
  527.   430 continue
  528.   436 continue
  529.   437 continue
  530.   438 continue
  531.   439 continue
  532. *
  533.         TETA1 = ture0(1)
  534.         TETA2 = turef(1)
  535.         IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN
  536.           VAR0(NVARI)=XMAT(20)
  537.         ENDIF
  538.         IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN
  539.           VAR0(NVARI-2)=XMAT(20)
  540.           VAR0(NVARI-1)=XMAT(21)
  541.           VAR0(NVARI)=XMAT(27)
  542.         ENDIF
  543.         FI1 = 0.D0
  544.         FI2 = 0.D0
  545.         IF (INPLAS.EQ.107) THEN
  546.           nexo = exova0(/1)
  547.           do 50 inex = 1,nexo
  548.             if ((nomexo(inex).eq.'DFIS').and.
  549.      &          (conexo(inex).eq.CONM)) then
  550.               fi1 = exova0(inex)
  551.               fi2 = exova1(inex)
  552.               goto 2001
  553.             endif
  554.  50       continue
  555.  2001     continue
  556.         ENDIF
  557. *
  558.         if (f(/1).ne.ncourb) segadj wrk7
  559.         if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA
  560.      >  .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or.
  561.      >  YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1
  562.      >  .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or.
  563.      >  YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX)
  564.      >  segadj wrk9
  565.         if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  566.      >      YALFT1(/1).ne.NYALFT1 .or.
  567.      >      YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  568.      >  YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  569.      >  YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  570.      >  YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  571.      >  segadj wrk91
  572. c
  573.       iforb=ifourb
  574.       nccor = ncourb
  575.  
  576.        CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  577.      1        NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  578.      4     TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  579. c
  580.       ifourb=iforb
  581.       ncourb=nccor
  582.         IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  583.           IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  584.             CALL ERREUR(KERREU1)
  585.           ENDIF
  586.         ENDIF
  587.         DTOPTI  = MIN(DTOPTI,DTT)
  588.         NINCMA = MAX(NINCMA,NSSINC)
  589.         NCOMP = NCOMP + 1
  590.         TSOM = TSOM + DTT
  591.         NSOM = NSOM + NSSINC
  592.         NINV = NINV + INV
  593.         TCAR = TCAR + DTT* DTT
  594.         IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  595.           KERR1=1
  596.         ENDIF
  597.         RETURN
  598. c
  599. ***   ELSE
  600. c       KERRE = 99
  601. *      ENDIF
  602. *
  603. *---------------------------------------------------------------------
  604. c
  605. c    modele viscoplastique parfait
  606. c
  607. *---------------------------------------------------------------------
  608.   343 continue
  609. *      IF ( INPLAS .EQ. 43 ) THEN
  610. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  611.       icarbi=icara
  612.       dtbi=dt
  613.       iforb=ifourb
  614.       nlmatb=nelmat
  615.       nbgmab=nbgmat
  616.       mfr1bi = mfr1
  617.       nstrbi=nstrss
  618.        CALL PRVPAR(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  619.      1            SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  620.      2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  621.      3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  622.      4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  623.       dt=dtbi
  624.       ifourb=iforb
  625.       nelmat=nlmatb
  626.       nbgmat=nbgmab
  627.       mfr1=mfr1bi
  628.       nstrss=nstrbi
  629.         IND = 0
  630.       RETURN
  631. c
  632. c    modele VISK2
  633. c
  634.   382 continue
  635. *      ELSE IF ( INPLAS .EQ. 82 ) THEN
  636. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  637.       icarbi=icara
  638.       dtbi=dt
  639.       iforb=ifourb
  640.       nlmatb=nelmat
  641.       nbgmab=nbgmat
  642.       mfr1bi = mfr1
  643.        nstrbi=nstrss
  644.        CALL PRVIK2(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  645.      1            SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  646.      2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  647.      3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  648.      4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  649.       nstrss=nstrbi
  650.       dt=dtbi
  651.       ifourb=iforb
  652.       nelmat=nlmatb
  653.       nbgmat=nbgmab
  654.       mfr1=mfr1bi
  655.         IND = 0
  656.       RETURN
  657. c
  658.   390 continue
  659. *      ELSE IF (INPLAS .EQ. 90) THEN
  660. C  VISCOHINTE
  661. C MODELE INTERFACE 2D
  662.         CALL VISHIN(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF,
  663.      &              VARF,DEFP,PRECIS,MFR1,KERRE,DT)
  664.  
  665.         IND =1
  666.         RETURN
  667. c-----------------------------------------------------------------------
  668. c    Modele MISTRAL
  669. c-----------------------------------------------------------------------
  670.   394 continue
  671. *      ELSE IF (INPLAS.EQ.94) THEN
  672.         FI1 = 0.D0
  673.         FI2 = 0.D0
  674.         nexo = exova0(/1)
  675.         do 60 inex = 1,nexo
  676.           if ((nomexo(inex).eq.'FI').and.(conexo(inex).eq.CONM)) then
  677.             fi1 = exova0(inex)
  678.             fi2 = exova1(inex)
  679.             goto 2002
  680.           endif
  681.  60     continue
  682.  2002   continue
  683.         CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  684.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
  685.         SEGINI WR13
  686.         CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  687.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
  688.         NDPI = nint(PNBRE(1))
  689.         NDVP = nint(PNBRE(2))
  690.         NXX  = nint(PNBRE(3))
  691.         NPSI = nint(PNBRE(4))
  692.         TETA1 = ture0(1)
  693.         TETA2 = turef(1)
  694.         CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
  695.      &              TETA2,FI2,DEPST, valmat,TXR,IDIM,
  696.      &              PDILT,NDPI,NDVP,NXX,NPSI,
  697.      &              PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  698.      &              NPINCR,PINCR,  SIGF,VARF,EPINF)
  699.         SEGSUP WR13
  700.         IND = 1
  701.        RETURN
  702. c-----------------------------------------------------------------------
  703. c  MODELE BPEL_RELAX
  704. c-----------------------------------------------------------------------
  705.   395 continue
  706. *      ELSE IF ( INPLAS .EQ. 95 ) THEN
  707. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  708.        nstrbi=nstrss
  709.        icarbi=icara
  710.        mfr1bi=mfr1
  711.        iforb=ifourb
  712.        nbgmab=nbgmat
  713.        nlmatb=nelmat
  714.        dtbi=dt
  715.        CALL ECBPEL(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  716.      1              NVARI,SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,
  717.      2              VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,
  718.      3              MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,
  719.      4              D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  720.       nstrss=nstrbi
  721.       dt=dtbi
  722.       ifourb=iforb
  723.       nelmat=nlmatb
  724.       nbgmat=nbgmab
  725.       mfr1=mfr1bi
  726.       icara=icarbi
  727.         IND = 0
  728.       RETURN
  729. c
  730. c     MODELE  BETON_URGC
  731. c
  732.   399 continue
  733.   400 continue
  734.   401 continue
  735.   420 continue
  736.   422 continue
  737. *      ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  738. *     1             (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN
  739. c
  740.         xlcar = bid(1)
  741.         TETA1 = ture0(1)
  742.         TETA2 = turef(1)
  743. c  modele BET_URGC : CONTRAINTES PLANES,
  744. c               DEFORMATION PLANES ET AXISYMETRIE
  745.         if (inplas.eq.100) inurgc = 1
  746. C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  747. C               DEFORMATION PLANES ET AXISYMETRIE
  748.         if (inplas.eq.99) inurgc = 0
  749. C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  750. C               DEFORMATION PLANES ET AXISYMETRIE
  751.         if (inplas.eq.101) inurgc = 2
  752. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  753. C               DEFORMATION PLANES ET AXISYMETRIE
  754.         if (inplas.eq.120) inurgc = 3
  755. C  modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  756. C               DEFORMATION PLANES ET AXISYMETRIE
  757.         if (inplas.eq.122) inurgc = 4
  758.  
  759.         nstrbi=nstrss
  760.        iforb=ifourb
  761.        dtbi=dt
  762.            CALL CURGCS(wrk52,wrk53,wrk54,WRK4,NSTRbi,IFORB,DTbi,IB,IGAU,
  763.      &                xlcar,inurgc,TETA1,TETA2)
  764.        nstrss=nstrbi
  765.        ifourb=iforb
  766.        dt=dtbi
  767.        RETURN
  768. C
  769.   421 continue
  770. *      ELSE IF (INPLAS.EQ.121) THEN
  771. c
  772.         xlcar = bid(1)
  773. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
  774.  
  775.         nstrbi=nstrss
  776.        iforb=ifourb
  777.        dtbi=dt
  778.           CALL bet3D(wrk52,wrk53,wrk54,WRK4,NSTRbi,IFORB,DTbi,IB,IGAU,
  779.      &                xlcar)
  780.        nstrss=nstrbi
  781.        ifourb=iforb
  782.        dt=dtbi
  783.        RETURN
  784. *
  785. *---------------------------------------------------------------------
  786. * modele fluage lemaitre LEMENDO
  787. *---------------------------------------------------------------------
  788.   403 continue
  789. *      ELSE IF (inplas.eq.103) THEN
  790.        iforb=ifourb
  791.        nbgmab=nbgmat
  792.        nlmatb=nelmat
  793.         CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  794.      &              NLMATb,IFORB)
  795.  
  796.        ifourb=iforb
  797.        nbgmat=nbgmab
  798.        nelmat=nlmatb
  799.        RETURN
  800. *---------------------------------------------------------------------
  801. * modele fluage type Norton FLUNOR2
  802. *---------------------------------------------------------------------
  803.   405 continue
  804. *      ELSE IF (inplas.eq.105) THEN
  805.        iforb=ifourb
  806.        nbgmab=nbgmat
  807.        nlmatb=nelmat
  808.         CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  809.      &              NLMATb,IFORB)
  810.        ifourb=iforb
  811.        nbgmat=nbgmab
  812.        nelmat=nlmatb
  813.        RETURN
  814. *---------------------------------------------------------------------
  815.       RETURN
  816.       END
  817.  
  818.  
  819.  
  820.  
  821.  
  822.  
  823.  
  824.  
  825.  
  826.  
  827.  

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