Télécharger la plaquette Cast3M


fr en

Télécharger coml7.eso

Retour à la liste

Numérotation des lignes : 

  1. C COML7     SOURCE    PV        17/12/08    21:16:42     9660           
  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. *---------------------------------------------------------------------
  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 (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.(conexo(inex).eq.CONM)) then
  680.             fi1 = exova0(inex)
  681.             fi2 = exova1(inex)
  682.             goto 2002
  683.           endif
  684.  60     continue
  685.  2002   continue
  686.         CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  687.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
  688.  
  689.         IF (WR13 .EQ. 0) SEGINI,WR13
  690.         IF (NPDILT.NE.PDILT(/1) .OR. NPNBRE.NE.PNBRE(/1) .OR. 
  691.      &      NPCOHI.NE.PCOHI(/1) .OR. NPECOU.NE.PECOU(/1) .OR. 
  692.      &      NPEDIR.NE.PEDIR(/1) .OR. NPRVCE.NE.PRVCE(/1) .OR. 
  693.      &      NPECRX.NE.PECRX(/1) .OR. NPDVDI.NE.PDVDI(/1) .OR.
  694.      &      NPCROI.NE.PCROI(/1) .OR. NPINCR.NE.PINCR(/1)) SEGADJ,WR13
  695.  
  696.         CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  697.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
  698.         NDPI = nint(PNBRE(1))
  699.         NDVP = nint(PNBRE(2))
  700.         NXX  = nint(PNBRE(3))
  701.         NPSI = nint(PNBRE(4))
  702.         TETA1 = ture0(1)
  703.         TETA2 = turef(1)
  704.         CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
  705.      &              TETA2,FI2,DEPST, valmat,TXR,IDIM,
  706.      &              PDILT,NDPI,NDVP,NXX,NPSI,
  707.      &              PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  708.      &              NPINCR,PINCR,  SIGF,VARF,EPINF)
  709. C       SEGSUP WR13
  710.         IND = 1
  711.        RETURN
  712. c-----------------------------------------------------------------------
  713. c  MODELE BPEL_RELAX
  714. c-----------------------------------------------------------------------
  715.   395 continue
  716. *      ELSE IF ( INPLAS .EQ. 95 ) THEN
  717. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  718.        nstrbi=nstrss
  719.        icarbi=icara
  720.        mfr1bi=mfr1
  721.        iforb=ifourb
  722.        nbgmab=nbgmat
  723.        nlmatb=nelmat
  724.        dtbi=dt
  725.        CALL ECBPEL(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  726.      1              NVARI,SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,
  727.      2              VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,
  728.      3              MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,
  729.      4              D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  730.       nstrss=nstrbi
  731.       dt=dtbi
  732.       ifourb=iforb
  733.       nelmat=nlmatb
  734.       nbgmat=nbgmab
  735.       mfr1=mfr1bi
  736.       icara=icarbi
  737.         IND = 0
  738.       RETURN
  739. c
  740. c     MODELE  BETON_URGC
  741. c
  742.   399 continue
  743.   400 continue
  744.   401 continue
  745.   420 continue
  746.   422 continue
  747. *      ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  748. *     1             (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN
  749. c
  750.         xlcar = bid(1)
  751.         TETA1 = ture0(1)
  752.         TETA2 = turef(1)
  753. c  modele BET_URGC : CONTRAINTES PLANES,
  754. c               DEFORMATION PLANES ET AXISYMETRIE
  755.         if (inplas.eq.100) inurgc = 1
  756. C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  757. C               DEFORMATION PLANES ET AXISYMETRIE
  758.         if (inplas.eq.99) inurgc = 0
  759. C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  760. C               DEFORMATION PLANES ET AXISYMETRIE
  761.         if (inplas.eq.101) inurgc = 2
  762. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  763. C               DEFORMATION PLANES ET AXISYMETRIE
  764.         if (inplas.eq.120) inurgc = 3
  765. C  modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  766. C               DEFORMATION PLANES ET AXISYMETRIE
  767.         if (inplas.eq.122) inurgc = 4
  768.  
  769.         nstrbi=nstrss
  770.        iforb=ifourb
  771.        dtbi=dt
  772.            CALL CURGCS(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  773.      &                xlcar,inurgc,TETA1,TETA2)
  774.        nstrss=nstrbi
  775.        ifourb=iforb
  776.        dt=dtbi
  777.        RETURN
  778. C
  779.   421 continue
  780. *      ELSE IF (INPLAS.EQ.121) THEN
  781. c
  782.         xlcar = bid(1)
  783. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
  784.  
  785.         nstrbi=nstrss
  786.        iforb=ifourb
  787.        dtbi=dt
  788.           CALL bet3D(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  789.      &                xlcar)
  790.        nstrss=nstrbi
  791.        ifourb=iforb
  792.        dt=dtbi
  793.        RETURN
  794. *
  795. *---------------------------------------------------------------------
  796. * modele fluage lemaitre LEMENDO
  797. *---------------------------------------------------------------------
  798.   403 continue
  799. *      ELSE IF (inplas.eq.103) THEN
  800.        iforb=ifourb
  801.        nbgmab=nbgmat
  802.        nlmatb=nelmat
  803.         CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  804.      &              NLMATb,IFORB)
  805.  
  806.        ifourb=iforb
  807.        nbgmat=nbgmab
  808.        nelmat=nlmatb
  809.        RETURN
  810. *---------------------------------------------------------------------
  811. * modele fluage type Norton FLUNOR2
  812. *---------------------------------------------------------------------
  813.   405 continue
  814. *      ELSE IF (inplas.eq.105) THEN
  815.        iforb=ifourb
  816.        nbgmab=nbgmat
  817.        nlmatb=nelmat
  818.         CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  819.      &              NLMATb,IFORB)
  820.        ifourb=iforb
  821.        nbgmat=nbgmab
  822.        nelmat=nlmatb
  823.        RETURN
  824. *---------------------------------------------------------------------
  825.       RETURN
  826.       END
  827.  
  828.  
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  

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