Télécharger la plaquette Cast3M


fr en

Télécharger coml7.eso

Retour à la liste

Numérotation des lignes : 

  1. C COML7     SOURCE    PASCAL    19/02/20    21:15:14     10116          
  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. *          121
  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. *          151
  260.      $     900,900,900,900,900,900,900,900,900,900,900,900,900,900,440
  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.   440 continue 
  533. *
  534.         TETA1 = ture0(1)
  535.         TETA2 = turef(1)
  536.         IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN
  537.           VAR0(NVARI)=XMAT(20)
  538.         ENDIF
  539.         IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN
  540.           VAR0(NVARI-2)=XMAT(20)
  541.           VAR0(NVARI-1)=XMAT(21)
  542.           VAR0(NVARI)=XMAT(27)
  543.         ENDIF
  544.         FI1 = 0.D0
  545.         FI2 = 0.D0
  546.         IF (INPLAS.EQ.107) THEN
  547.           nexo = exova0(/1)
  548.           do 50 inex = 1,nexo
  549.             if ((nomexo(inex)          .eq.'DFIS    ').and.
  550.      &          (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  551.               fi1 = exova0(inex)
  552.               fi2 = exova1(inex)
  553.               goto 2001
  554.             endif
  555.  50       continue
  556.  2001     continue
  557.         ENDIF
  558. *
  559.         if (wrk7.eq.0) segini wrk7
  560.         if (f(/1).ne.ncourb) segadj wrk7
  561.         if (wrk9.eq.0) segini wrk9
  562.         if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA
  563.      >  .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or.
  564.      >  YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1
  565.      >  .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or.
  566.      >  YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX)
  567.      >  segadj wrk9
  568.         if (wrk91.eq.0) segini wrk91
  569.         if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  570.      >      YALFT1(/1).ne.NYALFT1 .or.
  571.      >      YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  572.      >  YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  573.      >  YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  574.      >  YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  575.      >  segadj wrk91
  576. c
  577.       iforb=ifourb
  578.       nccor = ncourb
  579.  
  580.        CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  581.      1        NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  582.      4     TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  583. c
  584.       ifourb=iforb
  585.       ncourb=nccor
  586.         IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  587.           IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  588.             CALL ERREUR(KERREU1)
  589.           ENDIF
  590.         ENDIF
  591.         DTOPTI  = MIN(DTOPTI,DTT)
  592.         NINCMA = MAX(NINCMA,NSSINC)
  593.         NCOMP = NCOMP + 1
  594.         TSOM = TSOM + DTT
  595.         NSOM = NSOM + NSSINC
  596.         NINV = NINV + INV
  597.         TCAR = TCAR + DTT* DTT
  598.         IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  599.           KERR1=1
  600.         ENDIF
  601.         RETURN
  602. c
  603. ***   ELSE
  604. c       KERRE = 99
  605. *      ENDIF
  606. *
  607. *---------------------------------------------------------------------
  608. c
  609. c    modele viscoplastique parfait
  610. c
  611. *---------------------------------------------------------------------
  612.   343 continue
  613. *      IF ( INPLAS .EQ. 43 ) THEN
  614. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  615.       icarbi=icara
  616.       dtbi=dt
  617.       iforb=ifourb
  618.       nlmatb=nelmat
  619.       nbgmab=nbgmat
  620.       mfr1bi = mfr1
  621.       nstrbi=nstrss
  622.        CALL PRVPAR(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  623.      1            SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  624.      2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  625.      3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  626.      4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  627.       dt=dtbi
  628.       ifourb=iforb
  629.       nelmat=nlmatb
  630.       nbgmat=nbgmab
  631.       mfr1=mfr1bi
  632.       nstrss=nstrbi
  633.         IND = 0
  634.       RETURN
  635. c
  636. c    modele VISK2
  637. c
  638.   382 continue
  639. *      ELSE IF ( INPLAS .EQ. 82 ) THEN
  640. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  641.       icarbi=icara
  642.       dtbi=dt
  643.       iforb=ifourb
  644.       nlmatb=nelmat
  645.       nbgmab=nbgmat
  646.       mfr1bi = mfr1
  647.        nstrbi=nstrss
  648.        CALL PRVIK2(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  649.      1            SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  650.      2            N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  651.      3            NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  652.      4            ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  653.       nstrss=nstrbi
  654.       dt=dtbi
  655.       ifourb=iforb
  656.       nelmat=nlmatb
  657.       nbgmat=nbgmab
  658.       mfr1=mfr1bi
  659.         IND = 0
  660.       RETURN
  661. c
  662.   390 continue
  663. *      ELSE IF (INPLAS .EQ. 90) THEN
  664. C  VISCOHINTE
  665. C MODELE INTERFACE 2D
  666.         CALL VISHIN(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF,
  667.      &              VARF,DEFP,PRECIS,MFR1,KERRE,DT)
  668.  
  669.         IND =1
  670.         RETURN
  671. c-----------------------------------------------------------------------
  672. c    Modele MISTRAL
  673. c-----------------------------------------------------------------------
  674.   394 continue
  675. *      ELSE IF (INPLAS.EQ.94) THEN
  676.         FI1 = 0.D0
  677.         FI2 = 0.D0
  678.         nexo = exova0(/1)
  679.         do 60 inex = 1,nexo
  680.           if ((nomexo(inex)          .eq.'FI      ').and.
  681.      &        (conexo(inex)(1:LCONMO).eq. CONM(1:LCONMO))) then
  682.             fi1 = exova0(inex)
  683.             fi2 = exova1(inex)
  684.             goto 2002
  685.           endif
  686.  60     continue
  687.  2002   continue
  688.         CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  689.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
  690.  
  691.         IF (WR13 .EQ. 0) SEGINI,WR13
  692.         IF (NPDILT.NE.PDILT(/1) .OR. NPNBRE.NE.PNBRE(/1) .OR. 
  693.      &      NPCOHI.NE.PCOHI(/1) .OR. NPECOU.NE.PECOU(/1) .OR. 
  694.      &      NPEDIR.NE.PEDIR(/1) .OR. NPRVCE.NE.PRVCE(/1) .OR. 
  695.      &      NPECRX.NE.PECRX(/1) .OR. NPDVDI.NE.PDVDI(/1) .OR.
  696.      &      NPCROI.NE.PCROI(/1) .OR. NPINCR.NE.PINCR(/1)) SEGADJ,WR13
  697.  
  698.         CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  699.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
  700.         NDPI = nint(PNBRE(1))
  701.         NDVP = nint(PNBRE(2))
  702.         NXX  = nint(PNBRE(3))
  703.         NPSI = nint(PNBRE(4))
  704.         TETA1 = ture0(1)
  705.         TETA2 = turef(1)
  706.         CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
  707.      &              TETA2,FI2,DEPST, valmat,TXR,IDIM,
  708.      &              PDILT,NDPI,NDVP,NXX,NPSI,
  709.      &              PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  710.      &              NPINCR,PINCR,  SIGF,VARF,EPINF)
  711. C       SEGSUP WR13
  712.         IND = 1
  713.        RETURN
  714. c-----------------------------------------------------------------------
  715. c  MODELE BPEL_RELAX
  716. c-----------------------------------------------------------------------
  717.   395 continue
  718. *      ELSE IF ( INPLAS .EQ. 95 ) THEN
  719. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  720.        nstrbi=nstrss
  721.        icarbi=icara
  722.        mfr1bi=mfr1
  723.        iforb=ifourb
  724.        nbgmab=nbgmat
  725.        nlmatb=nelmat
  726.        dtbi=dt
  727.        CALL ECBPEL(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  728.      1              NVARI,SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,
  729.      2              VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,
  730.      3              MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,
  731.      4              D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  732.       nstrss=nstrbi
  733.       dt=dtbi
  734.       ifourb=iforb
  735.       nelmat=nlmatb
  736.       nbgmat=nbgmab
  737.       mfr1=mfr1bi
  738.       icara=icarbi
  739.         IND = 0
  740.       RETURN
  741. c
  742. c     MODELE  BETON_URGC
  743. c
  744.   399 continue
  745.   400 continue
  746.   401 continue
  747.   420 continue
  748.   422 continue
  749. *      ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  750. *     1             (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN
  751. c
  752.         xlcar = bid(1)
  753.         TETA1 = ture0(1)
  754.         TETA2 = turef(1)
  755. c  modele BET_URGC : CONTRAINTES PLANES,
  756. c               DEFORMATION PLANES ET AXISYMETRIE
  757.         if (inplas.eq.100) inurgc = 1
  758. C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  759. C               DEFORMATION PLANES ET AXISYMETRIE
  760.         if (inplas.eq.99) inurgc = 0
  761. C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  762. C               DEFORMATION PLANES ET AXISYMETRIE
  763.         if (inplas.eq.101) inurgc = 2
  764. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  765. C               DEFORMATION PLANES ET AXISYMETRIE
  766.         if (inplas.eq.120) inurgc = 3
  767. C  modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  768. C               DEFORMATION PLANES ET AXISYMETRIE
  769.         if (inplas.eq.122) inurgc = 4
  770.  
  771.         nstrbi=nstrss
  772.        iforb=ifourb
  773.        dtbi=dt
  774.            CALL CURGCS(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  775.      &                xlcar,inurgc,TETA1,TETA2)
  776.        nstrss=nstrbi
  777.        ifourb=iforb
  778.        dt=dtbi
  779.        RETURN
  780. C
  781.   421 continue
  782. *      ELSE IF (INPLAS.EQ.121) THEN
  783. c
  784.         xlcar = bid(1)
  785. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
  786.  
  787.         nstrbi=nstrss
  788.        iforb=ifourb
  789.        dtbi=dt
  790.           CALL bet3D(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  791.      &                xlcar)
  792.        nstrss=nstrbi
  793.        ifourb=iforb
  794.        dt=dtbi
  795.        RETURN
  796. *
  797. *---------------------------------------------------------------------
  798. * modele fluage lemaitre LEMENDO
  799. *---------------------------------------------------------------------
  800.   403 continue
  801. *      ELSE IF (inplas.eq.103) THEN
  802.        iforb=ifourb
  803.        nbgmab=nbgmat
  804.        nlmatb=nelmat
  805.         CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  806.      &              NLMATb,IFORB)
  807.  
  808.        ifourb=iforb
  809.        nbgmat=nbgmab
  810.        nelmat=nlmatb
  811.        RETURN
  812. *---------------------------------------------------------------------
  813. * modele fluage type Norton FLUNOR2
  814. *---------------------------------------------------------------------
  815.   405 continue
  816. *      ELSE IF (inplas.eq.105) THEN
  817.        iforb=ifourb
  818.        nbgmab=nbgmat
  819.        nlmatb=nelmat
  820.         CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  821.      &              NLMATb,IFORB)
  822.        ifourb=iforb
  823.        nbgmat=nbgmab
  824.        nelmat=nlmatb
  825.        RETURN
  826. *---------------------------------------------------------------------
  827.       RETURN
  828.       END
  829.  
  830.  
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  
  842.  
  843.  
  844.  
  845.  
  846.  

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