Télécharger la plaquette Cast3M


fr en

Télécharger coml7.eso

Retour à la liste

Numérotation des lignes : 

  1. C COML7     SOURCE    KICH      18/10/04    21:15:13     9946           
  2.       SUBROUTINE COML7(iqmod,wrk52,wrk53,wrk54,IB,igau,
  3.      & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  4.      & iretou,wrk12,wr13,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. *                  ecoulement selon les modeles
  192. *---------------------------------------------------------------------
  193. c
  194.       NBPGAU = NBGS
  195.       NVARI  = NVART
  196. c
  197. *---------------------------------------------------------------------
  198. c      modele elastique lineaire
  199. *---------------------------------------------------------------------
  200.       IF (INPLAS.EQ.0)THEN
  201. * barres et poutres
  202.         IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN
  203.          IF (CMATE.EQ.'SECTION ') THEN
  204.           IPM = int(xmat(1))
  205.           IPC = int(xmat(2))
  206.           MLREEL = NINT(XMAT(3))
  207.           IF(MLREEL.EQ.0)THEN
  208.             CALL FRIGIE(IPM,IPC,CRIGI,CMASS)
  209.           ELSE
  210.             SEGACT, MLREEL
  211.             CALL BIFLX1(PROG(1),NSTRS,CRIGI)
  212.             SEGDES, MLREEL
  213.           ENDIF
  214.          ENDIF
  215.         ENDIF
  216. c
  217.         CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  218.      1              MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,NPINT,NBGMAT,
  219.      2              NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,
  220.      3              DDHOMU,CRIGI,DSIGT,IRTD)
  221. *
  222.         IF(IRTD.EQ.1) THEN
  223.           DO 10 IC=1,NSTRSS
  224.             SIGF(IC)=SIG0(IC)+DSIGT(IC)
  225.  10       CONTINUE
  226. *
  227.            DO 20  IC=1,NVARI
  228.             VARF(IC)=VAR0(IC)
  229.  20       CONTINUE
  230.         ELSE
  231.           KERRE=69
  232.         ENDIF
  233.         RETURN
  234.       ENDIF
  235. c
  236. *---------------------------------------------------------------------
  237. c     modeles implantes dans ccoinc
  238. *---------------------------------------------------------------------
  239. * appel ccoin0 et ccoinc
  240. * mfr1 <- MFR , nstrss <- nstrs , wrk52 <- wrk0
  241. * CCOTRA <- COTRAC , xcarb <- XCAR
  242. *---------------------------------------------------------------------
  243. c
  244. c           1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  245.       GOTO(301,300,303,304,305,300,307,300,300,300,300,312,300,300,315,
  246.      $     300,317,300,319,320,321,322,323,324,325,300,300,300,300,300,
  247. *           31
  248.      $     300,300,300,300,300,300,300,300,300,300,300,300,343,344,345,
  249.      $     300,300,300,300,300,300,300,353,300,300,300,300,300,300,300,
  250. *           61
  251.      $     361,300,363,300,300,300,300,300,300,370,300,300,300,300,300,
  252.      $     376,377,300,300,300,300,382,300,384,385,386,387,300,300,390,
  253. *           91
  254.      $     300,300,300,394,395,300,300,300,300,400,401,402,403,900,405,
  255.      $     900,407,900,400,900,411,412,413,900,900,900,900,900,900,420,
  256. *          421
  257.      $     421,422,900,900,900,900,900,900,900,430,900,900,900,900,900,
  258.      $     436,437,438,439,900,900,900,900,900,900,900,900,900,900,900,
  259. *          451
  260.      $     900,900,900,900,900,900,900,900,900,900,900,900,900,900,900
  261.      $ ) INPLAS
  262.   300 continue
  263.   900 continue
  264.        write(ioimp,*) ' erreur d aiguillage coml7 '
  265.        call erreur(5)
  266.        return
  267.  
  268. *      ELSE IF ( INPLAS .EQ.  1 .OR. INPLAS .EQ.  3 .OR.
  269. *     2          INPLAS .EQ.  4 .OR. INPLAS .EQ.  5 .OR.
  270. *     3          INPLAS .EQ.  7 .OR. INPLAS .EQ. 12 .OR.
  271. *     4          INPLAS .EQ. 15 .OR. INPLAS .EQ. 87 ) THEN
  272. c
  273. c     modele von mises isotrope associe ( d'apres inca )
  274. c
  275. *        IF (INPLAS .EQ. 1) THEN
  276.  301  continue
  277. c
  278. c    cas de la plasticite parfaite
  279. c
  280.           NCOURB=2
  281.           IF (MATE.EQ.4.AND.(MFRbi.EQ.1.OR.MFRbi.EQ.31)
  282.      +.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.OR.MFRbi.EQ.31)
  293.      +.AND.IDIM.EQ.3.AND.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 .OR. MFRbi .EQ. 31)     .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)(1:LCONMO).eq.CONM(1:LCONMO))) 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 (wrk7.eq.0) segini wrk7
  559.         if (f(/1).ne.ncourb) segadj wrk7
  560.         if (wrk9.eq.0) segini wrk9
  561.         if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA
  562.      >  .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or.
  563.      >  YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1
  564.      >  .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or.
  565.      >  YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX)
  566.      >  segadj wrk9
  567.         if (wrk91.eq.0) segini wrk91
  568.         if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  569.      >      YALFT1(/1).ne.NYALFT1 .or.
  570.      >      YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  571.      >  YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  572.      >  YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  573.      >  YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  574.      >  segadj wrk91
  575. c
  576.       iforb=ifourb
  577.       nccor = ncourb
  578.  
  579.        CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  580.      1        NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  581.      4     TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  582. c
  583.       ifourb=iforb
  584.       ncourb=nccor
  585.         IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  586.           IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  587.             CALL ERREUR(KERREU1)
  588.           ENDIF
  589.         ENDIF
  590.         DTOPTI  = MIN(DTOPTI,DTT)
  591.         NINCMA = MAX(NINCMA,NSSINC)
  592.         NCOMP = NCOMP + 1
  593.         TSOM = TSOM + DTT
  594.         NSOM = NSOM + NSSINC
  595.         NINV = NINV + INV
  596.         TCAR = TCAR + DTT* DTT
  597.         IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  598.           KERR1=1
  599.         ENDIF
  600.         RETURN
  601. c
  602. ***   ELSE
  603. c       KERRE = 99
  604. *      ENDIF
  605. *
  606. *---------------------------------------------------------------------
  607. c
  608. c    modele viscoplastique parfait
  609. c
  610. *---------------------------------------------------------------------
  611.   343 continue
  612. *      IF ( INPLAS .EQ. 43 ) THEN
  613. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  614.       icarbi=icara
  615.       dtbi=dt
  616.       iforb=ifourb
  617.       nlmatb=nelmat
  618.       nbgmab=nbgmat
  619.       mfr1bi = mfr1
  620.       nstrbi=nstrss
  621.        CALL PRVPAR(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  622.      1            SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  623.      2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  624.      3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  625.      4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  626.       dt=dtbi
  627.       ifourb=iforb
  628.       nelmat=nlmatb
  629.       nbgmat=nbgmab
  630.       mfr1=mfr1bi
  631.       nstrss=nstrbi
  632.         IND = 0
  633.       RETURN
  634. c
  635. c    modele VISK2
  636. c
  637.   382 continue
  638. *      ELSE IF ( INPLAS .EQ. 82 ) THEN
  639. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  640.       icarbi=icara
  641.       dtbi=dt
  642.       iforb=ifourb
  643.       nlmatb=nelmat
  644.       nbgmab=nbgmat
  645.       mfr1bi = mfr1
  646.        nstrbi=nstrss
  647.        CALL PRVIK2(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  648.      1            SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  649.      2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  650.      3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  651.      4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  652.       nstrss=nstrbi
  653.       dt=dtbi
  654.       ifourb=iforb
  655.       nelmat=nlmatb
  656.       nbgmat=nbgmab
  657.       mfr1=mfr1bi
  658.         IND = 0
  659.       RETURN
  660. c
  661.   390 continue
  662. *      ELSE IF (INPLAS .EQ. 90) THEN
  663. C  VISCOHINTE
  664. C MODELE INTERFACE 2D
  665.         CALL VISHIN(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF,
  666.      &              VARF,DEFP,PRECIS,MFR1,KERRE,DT)
  667.  
  668.         IND =1
  669.         RETURN
  670. c-----------------------------------------------------------------------
  671. c    Modele MISTRAL
  672. c-----------------------------------------------------------------------
  673.   394 continue
  674. *      ELSE IF (INPLAS.EQ.94) THEN
  675.         FI1 = 0.D0
  676.         FI2 = 0.D0
  677.         nexo = exova0(/1)
  678.         do 60 inex = 1,nexo
  679.           if ((nomexo(inex)          .eq.'FI      ').and.
  680.      &        (conexo(inex)(1:LCONMO).eq. CONM(1:LCONMO))) then
  681.             fi1 = exova0(inex)
  682.             fi2 = exova1(inex)
  683.             goto 2002
  684.           endif
  685.  60     continue
  686.  2002   continue
  687.         CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  688.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
  689.  
  690.         IF (WR13 .EQ. 0) SEGINI,WR13
  691.         IF (NPDILT.NE.PDILT(/1) .OR. NPNBRE.NE.PNBRE(/1) .OR. 
  692.      &      NPCOHI.NE.PCOHI(/1) .OR. NPECOU.NE.PECOU(/1) .OR. 
  693.      &      NPEDIR.NE.PEDIR(/1) .OR. NPRVCE.NE.PRVCE(/1) .OR. 
  694.      &      NPECRX.NE.PECRX(/1) .OR. NPDVDI.NE.PDVDI(/1) .OR.
  695.      &      NPCROI.NE.PCROI(/1) .OR. NPINCR.NE.PINCR(/1)) SEGADJ,WR13
  696.  
  697.         CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  698.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
  699.         NDPI = nint(PNBRE(1))
  700.         NDVP = nint(PNBRE(2))
  701.         NXX  = nint(PNBRE(3))
  702.         NPSI = nint(PNBRE(4))
  703.         TETA1 = ture0(1)
  704.         TETA2 = turef(1)
  705.         CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
  706.      &              TETA2,FI2,DEPST, valmat,TXR,IDIM,
  707.      &              PDILT,NDPI,NDVP,NXX,NPSI,
  708.      &              PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  709.      &              NPINCR,PINCR,  SIGF,VARF,EPINF)
  710. C       SEGSUP WR13
  711.         IND = 1
  712.        RETURN
  713. c-----------------------------------------------------------------------
  714. c  MODELE BPEL_RELAX
  715. c-----------------------------------------------------------------------
  716.   395 continue
  717. *      ELSE IF ( INPLAS .EQ. 95 ) THEN
  718. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  719.        nstrbi=nstrss
  720.        icarbi=icara
  721.        mfr1bi=mfr1
  722.        iforb=ifourb
  723.        nbgmab=nbgmat
  724.        nlmatb=nelmat
  725.        dtbi=dt
  726.        CALL ECBPEL(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  727.      1              NVARI,SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,
  728.      2              VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,
  729.      3              MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,
  730.      4              D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  731.       nstrss=nstrbi
  732.       dt=dtbi
  733.       ifourb=iforb
  734.       nelmat=nlmatb
  735.       nbgmat=nbgmab
  736.       mfr1=mfr1bi
  737.       icara=icarbi
  738.         IND = 0
  739.       RETURN
  740. c
  741. c     MODELE  BETON_URGC
  742. c
  743.   399 continue
  744.   400 continue
  745.   401 continue
  746.   420 continue
  747.   422 continue
  748. *      ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  749. *     1             (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN
  750. c
  751.         xlcar = bid(1)
  752.         TETA1 = ture0(1)
  753.         TETA2 = turef(1)
  754. c  modele BET_URGC : CONTRAINTES PLANES,
  755. c               DEFORMATION PLANES ET AXISYMETRIE
  756.         if (inplas.eq.100) inurgc = 1
  757. C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  758. C               DEFORMATION PLANES ET AXISYMETRIE
  759.         if (inplas.eq.99) inurgc = 0
  760. C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  761. C               DEFORMATION PLANES ET AXISYMETRIE
  762.         if (inplas.eq.101) inurgc = 2
  763. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  764. C               DEFORMATION PLANES ET AXISYMETRIE
  765.         if (inplas.eq.120) inurgc = 3
  766. C  modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  767. C               DEFORMATION PLANES ET AXISYMETRIE
  768.         if (inplas.eq.122) inurgc = 4
  769.  
  770.         nstrbi=nstrss
  771.        iforb=ifourb
  772.        dtbi=dt
  773.            CALL CURGCS(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  774.      &                xlcar,inurgc,TETA1,TETA2)
  775.        nstrss=nstrbi
  776.        ifourb=iforb
  777.        dt=dtbi
  778.        RETURN
  779. C
  780.   421 continue
  781. *      ELSE IF (INPLAS.EQ.121) THEN
  782. c
  783.         xlcar = bid(1)
  784. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
  785.  
  786.         nstrbi=nstrss
  787.        iforb=ifourb
  788.        dtbi=dt
  789.           CALL bet3D(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  790.      &                xlcar)
  791.        nstrss=nstrbi
  792.        ifourb=iforb
  793.        dt=dtbi
  794.        RETURN
  795. *
  796. *---------------------------------------------------------------------
  797. * modele fluage lemaitre LEMENDO
  798. *---------------------------------------------------------------------
  799.   403 continue
  800. *      ELSE IF (inplas.eq.103) THEN
  801.        iforb=ifourb
  802.        nbgmab=nbgmat
  803.        nlmatb=nelmat
  804.         CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  805.      &              NLMATb,IFORB)
  806.  
  807.        ifourb=iforb
  808.        nbgmat=nbgmab
  809.        nelmat=nlmatb
  810.        RETURN
  811. *---------------------------------------------------------------------
  812. * modele fluage type Norton FLUNOR2
  813. *---------------------------------------------------------------------
  814.   405 continue
  815. *      ELSE IF (inplas.eq.105) THEN
  816.        iforb=ifourb
  817.        nbgmab=nbgmat
  818.        nlmatb=nelmat
  819.         CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  820.      &              NLMATb,IFORB)
  821.        ifourb=iforb
  822.        nbgmat=nbgmab
  823.        nelmat=nlmatb
  824.        RETURN
  825. *---------------------------------------------------------------------
  826.       RETURN
  827.       END
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  
  842.  
  843.  
  844.  

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