Télécharger la plaquette Cast3M


fr en

Télécharger coml7.eso

Retour à la liste

Numérotation des lignes : 

coml7

  1. C COML7     SOURCE    CB215821  24/04/12    21:15:24     11897          
  2.       SUBROUTINE COML7(iqmod,wrk52,wrk53,wrk54,IB,igau,
  3.      & wrk2,mwrkxe,wrk3,wrk7,wrk8,wrk9,wrk91,iretou,
  4.      & wr13,wr14,ecou,iecou,necou,xecou,ifus)
  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.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16. -INC SMLREEL
  17. -INC SMMODEL
  18. -INC SMELEME
  19. -INC SMINTE
  20. -INC CCHAMP
  21. -INC SMCOORD
  22. * segment deroulant le mcheml
  23. -INC DECHE
  24. *
  25.       SEGMENT WRK2
  26.         REAL*8 TRAC(LTRAC)
  27.       ENDSEGMENT
  28. *
  29.       SEGMENT WRK3
  30.         REAL*8 WORK(LW),WORK2(LW2)
  31.       ENDSEGMENT
  32. *
  33.       SEGMENT MWRKXE
  34.         REAL*8 XE(3,NBNN)
  35.       ENDSEGMENT
  36. *
  37.       SEGMENT ENDO0
  38.         REAL*8 ENDO(LENDO),RAPP(LENDO)
  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. c mistral :
  66.       SEGMENT WR13
  67.         REAL*8 PDILT(NPDILT),PNBRE(NPNBRE),PCOHI(NPCOHI),PECOU(NPECOU)
  68.         REAL*8 PEDIR(NPEDIR),PRVCE(NPRVCE),PECRX(NPECRX),PDVDI(NPDVDI)
  69.         REAL*8 PCROI(NPCROI)
  70.         REAL*8 PINCR(NPINCR)
  71.       ENDSEGMENT
  72. *     
  73. c  fluendo3D
  74.       SEGMENT WR14
  75.         INTEGER INLVIA(NBVIA)
  76.       ENDSEGMENT
  77. *
  78.       REAL*8 CRIGI(12),CMASS(12),XCAR(1)
  79. *
  80. *  Segment ECOU: sert de fourre-tout pour les tableaux
  81. *
  82.       SEGMENT ECOU
  83.        REAL*8 TEST, ALFAH,
  84.      1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  85.      2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  86.      1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  87.      2 SIPLAD(6),DSIGP0(6),TET,TETI
  88.       ENDSEGMENT
  89. *
  90. *  Segment NECOU utilisé dans CCOINC
  91. *
  92.       SEGMENT NECOU
  93.        INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  94.      . ITYP,IFOURB,IFLUAG,
  95.      . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  96.      . JFLUAG,KFLUAG,LFLUAG,
  97.      . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  98.       ENDSEGMENT
  99. *
  100. *  Segment IECOU: sert de fourre-tout pour les initialisations
  101. *  d'entiers
  102. *
  103.       SEGMENT IECOU
  104.       INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  105.      .  NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  106.      .  NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  107.      .  IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  108.      .  MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  109.      .  KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  110.      .  NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  111.       ENDSEGMENT
  112. *
  113. *  Segment XECOU: sert de fourre-tout pour les initialisations
  114. *  de réels
  115. *
  116.       SEGMENT XECOU
  117.        REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  118.       ENDSEGMENT
  119. *
  120. *      moterr(1:6) = 'COML7  '
  121. *      moterr(7:15) = 'element '
  122. *      interr(1) = ib
  123. *      interr(2) = igau
  124. *      call erreur(-329)
  125.  
  126.       imodel = iqmod
  127. *---------------------------------------------------------------------
  128. *                  ecoulement selon les modeles
  129. *---------------------------------------------------------------------
  130. c
  131.       NBPGAU = NBGS
  132.       NVARI  = NVART
  133. C
  134. C======================================================================
  135. C                     MODELE ELASTIQUE LINEAIRE
  136. C======================================================================
  137. C     write(6,*) 'COML7 : IFUS =',IFUS
  138.       IF (INPLAS.EQ.0.OR.IFUS.EQ.1) THEN
  139. * barres et poutres
  140.         IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN
  141.           IF (CMATE.EQ.'SECTION ') THEN
  142.             IPM = int(xmat(1))
  143.             IPC = int(xmat(2))
  144.             MLREEL = NINT(XMAT(3))
  145.             IF(MLREEL.EQ.0)THEN
  146.               CALL FRIGIE(IPM,IPC,CRIGI,CMASS)
  147.             ELSE
  148.               SEGACT, MLREEL
  149.               CALL BIFLX1(PROG(1),NSTRS,CRIGI)
  150.               SEGDES, MLREEL
  151.             ENDIF
  152.           ENDIF
  153.         ENDIF
  154. c
  155.         CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,
  156.      1              MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,NPINT,NBGMAT,
  157.      2              NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,
  158.      3              DDHOMU,CRIGI,DSIGT,IRTD)
  159.  
  160.         IF (IRTD.EQ.1) THEN
  161.           DO 10 IC=1,NSTRSS
  162.             SIGF(IC)=SIG0(IC)+DSIGT(IC)
  163.  10       CONTINUE
  164.  
  165.           XVAR = 1.D0
  166.           IF (IFUS.EQ.1) XVAR = 0.D0
  167.  
  168.           DO 20  IC=1,NVARI
  169.             VARF(IC) = XVAR*VAR0(IC)
  170.  20       CONTINUE
  171.  
  172.           IF (IFUS.EQ.1) THEN
  173.             NDEIN = EPIN0(/1)
  174. C     write(6,*) 'COML7 : NDEIN =',NDEIN
  175.             DO 21  IC=1,NDEIN
  176.               EPINF(IC) = EPIN0(IC)
  177.               DEFP(IC)  = 0.D0
  178.  21         CONTINUE
  179.           ENDIF
  180.  
  181.         ELSE
  182.           KERRE=69
  183.         ENDIF
  184.  
  185.         RETURN
  186.       ENDIF
  187. C
  188. *---------------------------------------------------------------------
  189. * appel ccoin0 et ccoinc
  190. * mfr1 <- MFR , nstrss <- nstrs , wrk52 <- wrk0
  191. * CCOTRA <- COTRAC , xcarb <- XCAR
  192. *---------------------------------------------------------------------
  193. C
  194. C           1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
  195.       GOTO(301,300,303,304,305,300,307,300,300,300,300,312,300,300,315,
  196.      $     300,317,300,319,320,321,322,323,324,325,300,300,300,300,300,
  197. *           31
  198.      $     300,300,300,300,300,300,300,300,300,300,300,300,343,344,345,
  199.      $     300,300,300,300,350,351,300,353,300,300,300,300,300,300,300,
  200. *           61
  201.      $     361,300,363,300,300,300,300,300,300,370,300,300,300,300,300,
  202.      $     376,377,300,300,300,300,382,300,384,385,386,387,300,300,390,
  203. *           91
  204.      $     300,300,300,394,395,300,300,300,300,400,401,402,403,300,405,
  205.      $     300,407,300,300,300,411,412,413,300,300,300,300,300,300,420,
  206. *          121
  207.      $     421,422,300,300,300,300,300,300,300,430,300,300,300,300,300,
  208.      $     436,437,438,439,300,300,300,300,300,300,300,300,300,300,300,
  209. *          151
  210.      $     300,300,300,300,300,300,300,300,300,300,300,300,300,300,440,
  211.      $     300,300,300,300,300,300,300,300,300,300,300,300,300,300,440,
  212. *          181                     <---Sellier------->
  213.      $     300,300,300,300,300,300,487,488,489,490,491,300,300,300,300 
  214.      $ ) INPLAS
  215. C
  216. C======================================================================
  217.   300 CONTINUE
  218.       WRITE(IOIMP,*) ' ERREUR D AIGUILLAGE COML7 '
  219.       CALL ERREUR(5)
  220.       RETURN
  221. C
  222. C======================================================================
  223. C             MODELES PLASTIQUES VIA CCOINC OU CCOIN0
  224. C======================================================================
  225. C     MODELE PLASTIQUE PARFAIT
  226.  301  CONTINUE
  227.       NCOURB=2
  228.       IF (MATE.EQ.4.AND.(MFRbi.EQ.1.OR.MFRbi.EQ.31)
  229.      +.AND.IDIM.EQ.3) THEN
  230.         TRAC(1)=XMAT(9)
  231.         TRAC(3)=XMAT(9)
  232.       ELSE
  233.         TRAC(1)=XMAT(5)
  234.         TRAC(3)=XMAT(5)
  235.       ENDIF
  236.       TRAC(2)=0.D0
  237.       TRAC(4)=1.D9
  238. **    write(6,*) 'coml7 dimension de xmat ',xmat(/1)
  239.       IF( (IDIM.EQ.2.AND.XMAT(5).EQ.0.D0).OR.
  240.      +        (MATE.EQ.4.AND.(MFRbi.EQ.1.OR.MFRbi.EQ.31)
  241.      +.AND.IDIM.EQ.3.and.xmat(/1).ge.9.AND.XMAT(min(9,xmat(/1)))
  242.      >     .EQ.0.D0)) THEN
  243.         KERRE = 33
  244.       ELSE
  245.         KERRE = 0
  246.       ENDIF
  247.       GO TO 800
  248. C
  249. C     -----------------------------------------------------------------
  250. C     MODELE PLASTIQUE DRUCKER_PARFAIT
  251.   303 CONTINUE
  252. c
  253. c    cas du modele de drucker-prager parfait
  254. c    les donnees sont les limites en traction et en compression
  255. c
  256.       IMAPLA=5
  257.       DEN =  ABS(XMAT(6)) + XMAT(5)
  258.       IF(DEN.EQ.0.D0) THEN
  259.         KERRE=48
  260.       ELSE
  261.         XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  262.         XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  263.         XMAT(6) = 1.D0
  264.         XMAT(8)=XMAT(5)
  265.         XMAT(9)=XMAT(6)
  266.         XMAT(10)=XMAT(5)
  267.         XMAT(11)=XMAT(6)
  268.         XMAT(12)=XMAT(7)
  269.         XMAT(13)=0.D0
  270. c
  271. c       petits tests sur les donnees
  272.         IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  273.      &     XMAT(5)*1.01/(XMAT(6)+1.D-20)
  274.      &         .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  275.           KERRE = 48
  276.         ELSE
  277.           KERRE = 0
  278.         ENDIF
  279.         ENDIF
  280.         GO TO 800
  281. C
  282. C     -----------------------------------------------------------------
  283. C     MODELE PLASTIQUE CINEMATIQUE
  284.   304 CONTINUE
  285. c
  286. c    cas de la plasticite cinematique bilineaire
  287. c
  288.       IF(XMAT(5).EQ.0.D0) THEN
  289.         KERRE=33
  290.       ELSE
  291.         ICINE=1
  292.         NCOURB=2
  293.         TRAC(1)=XMAT(5)
  294.         TRAC(2)=0.D0
  295.         TRAC(4)=1.D9
  296.         TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4)
  297.       ENDIF
  298.       GOTO 800
  299. C
  300. C     -----------------------------------------------------------------
  301. C     MODELES PLASTIQUE ISOTROPE ET ELASTIQUE NON LINEAIRE
  302.   305 CONTINUE
  303.   387 CONTINUE
  304. c
  305. c   cas de la plasticite isotrope ecrouissable
  306. c
  307. c  on recupere la courbe de traction
  308. c
  309.       nccor=ncourb
  310.       CALL CCOTRA(WRK52,WRK2,NCcor,WRK53)
  311.       ncourb=nccor
  312.       GO TO 800
  313. C
  314. C     -----------------------------------------------------------------
  315. C     MODELE PLASTIQUE CHABOCHE1
  316.   307 CONTINUE
  317.       KERRE = 0
  318.       ICINE = 1
  319.       IMAPLA= 4
  320.       GO TO 800
  321. C
  322. C     -----------------------------------------------------------------
  323. C     MODELE PLASTIQUE CHABOCHE2
  324.   312 CONTINUE
  325.       KERRE = 0
  326.       ICINE = 1
  327.       IMAPLA= 4
  328.       GO TO 800
  329. C
  330. C     -----------------------------------------------------------------
  331. C     MODELE PLASTIQUE DRUCKER_PRAGER
  332.   315 CONTINUE
  333.       IMAPLA=5
  334. c
  335. c     petits tests sur les donnees
  336. c
  337.       IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  338.      1   XMAT(5)*1.01/(XMAT(6)+1.D-20)
  339.      2       .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  340.         KERRE = 48
  341.       ELSE
  342.         KERRE = 0
  343. c
  344. c       permutations pour ecoinc
  345. c
  346.         DO 30 I=5,7
  347.           WW=XMAT(I)
  348.           XMAT(I)=XMAT(I+5)
  349.           XMAT(I+5)=WW
  350.  30     CONTINUE
  351.       ENDIF
  352.       GO TO 800
  353. C
  354. C     -----------------------------------------------------------------
  355. C     MODELE PLASTIQUE_ENDOM PSURY 
  356.   351 CONTINUE
  357. C
  358.       SEGINI ENDO0
  359. c   cas de la plasticite isotrope ecrouissable avec un
  360. c   endommagement de type P/Y
  361. c
  362. c on recupere la courbe de traction et la courbe de début d'endommagement
  363.       nccor=ncourb
  364.       CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP)
  365.       ncourb=nccor
  366.       IF (VAR0(7).GE.1.D-10) THEN
  367.         DO 110 I=1,NSTRS
  368.           SIG0(I)=SIG0(I)/VAR0(7)
  369. 110     CONTINUE
  370.       ENDIF
  371. C
  372. C     -----------------------------------------------------------------
  373.  800  CONTINUE
  374.       IF (KERRE .NE. 0) RETURN
  375. **    write(6,*) 'coml7 icara en 373',icara
  376.       DO 40 IC=1,ICARA
  377.         WORK(IC)=XCARB(IC)
  378. 40    CONTINUE
  379. **    write(6,*) 'work',(work(ic),ic=1,icara)
  380.       BID(1)=0.D00
  381.       BID(2)=0.D00
  382.       BID(3)=0.D00
  383.  
  384.  
  385.       IF ((INPLAS .EQ. 1 .OR.INPLAS .EQ. 4  .OR.
  386.      &     INPLAS .EQ. 5 .OR.INPLAS .EQ. 7  .OR.
  387.      &     INPLAS .EQ. 12.OR.INPLAS .EQ. 87 ) .AND.
  388.      &     (MFRbi .EQ. 1 .OR. MFRbi .EQ. 3 .OR.
  389.      &      MFRbi .EQ. 5 .OR. MFRbi .EQ. 7 .OR.
  390.      &      MFRbi .EQ. 9 .OR. MFRbi .EQ. 31)  .AND.
  391.      &     (CMATE.NE.'UNIDIREC')) THEN
  392. c
  393.         nccor=ncourb
  394.         iforb=ifourb
  395.  
  396.         CALL CCOIN0(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  397.      &                  NBPGAU,NCcor,IFORB,iecou)
  398.         ncourb=nccor
  399.         ifourb=iforb
  400. c
  401.       ELSE
  402. c
  403.         CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  404.      &                  NBPGAU,ecou,necou,iecou)
  405. C
  406. C     Modele d'endommagement P/Y : calcul des contraintes endommagees
  407.         IF (INPLAS.EQ.51) THEN
  408.           CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP,
  409.      &               NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  410.           SEGSUP ENDO0
  411.         ENDIF
  412. C
  413.       ENDIF
  414. C
  415.       RETURN
  416. C
  417. C======================================================================
  418. C     MODELE PLASTIQUE ZERILI (Modele de Zerili-Armstrong)
  419. C======================================================================
  420.   350 CONTINUE
  421. c     on recupere le pas de temps dt : voir comval
  422. c     kich : fixe dt = 0. pour plasticite
  423.       dtk1 = dt
  424.       dt = 0.d0
  425. c
  426.       IF (KERRE .EQ. 0) THEN
  427. **    write(6,*) 'coml7 icara en 424',icara
  428.         DO 1124 IC=1,ICARA
  429.           WORK(IC)=xcarb(IC)
  430. 1124    CONTINUE
  431.         BID(1)=0.D00
  432.         BID(2)=0.D00
  433.         BID(3)=0.D00
  434.         CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  435.      &              NBPGAU,necou,ecou,iecou,xecou)
  436.       ENDIF
  437.       dt = dtk1
  438.       RETURN
  439. C
  440. C======================================================================
  441. C     MODELES PLASTIQUE INPLAS 111, 112 et 113
  442. C======================================================================
  443.   411 CONTINUE
  444.   412 CONTINUE
  445.   413 CONTINUE
  446. C     Calcula incremento de tensiones trial, DSIGT
  447.       call CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,
  448.      .                   N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,
  449.      .               NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  450.      .               XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  451.       nescri   =0
  452.       nues     =6
  453.       nitmax   =25
  454.       precis   =1.E-10
  455. C
  456. C     MODELE PLASTIQUE MRS_LADE
  457.       IF (INPLAS.eq.111) THEN
  458. C       mrs-lade requiere siempre derivacion numerica
  459.         nnumer=3
  460.         deltax=2.D0**(int(log10(1.D-6)/log10(2.D0)))
  461.         call eco_MRSMAC(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  462.      .                  NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  463.      .                  nues,nnumer,deltax,kdummy)
  464. C
  465. C     MODELE PLASTIQUE J2
  466.       ELSE IF (INPLAS.eq.112) THEN
  467.         call eco_j2(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  468.      .              NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  469.      .              nues,kdummy)
  470. C
  471. C     MODELE PLASTIQUE RH_COULOMB (Rounded Hyperbolic Mohr-Coulomb)
  472.       ELSE IF (INPLAS.eq.113) THEN
  473.         call eco_rhmc(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  474.      .                NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  475.      .                nues,kdummy)
  476.       ENDIF
  477.       IF (KERRE.EQ.1) THEN
  478. c       write(*,*) ' Nonconvergence c7 at elem: ', ib,' gauss:',igau
  479.         KERRE=99
  480.       ENDIF
  481.       RETURN
  482. C======================================================================
  483. C           MODELES VISCOPLASTIQUE ET FLUAGE VIA CCONST
  484. C======================================================================
  485. C     MODELE VISCOPLASTIQUE GUIONNET
  486.   317 continue
  487. C     MODELE FLUAGE NORTON
  488.   319 continue
  489. C     MODELE FLUAGE BLACKBURN
  490.   320 continue
  491. C     MODELE FLUAGE POLYNOMIAL
  492.   321 continue
  493. C     MODELE FLUAGE RCCMR-316
  494.   322 continue
  495. C     MODELE FLUAGE RCCMR-304
  496.   323 continue
  497. C     MODELE FLUAGE LEMAITRE
  498.   324 continue
  499. C     MODELE VISCOPLASTIQUE ONERA
  500.   325 continue
  501. C     MODELE VISCOPLASTIQUE POUDRE_A
  502.   344 continue
  503. C     MODELE VISCOPLASTIQUE POUDRE_B
  504.   345 continue
  505. C     MODELE VISCOPLASTIQUE OHNO
  506.   353 continue
  507. C     MODELE FLUAGE BLACKBURN_2
  508.   361 continue
  509. C     MODELE VISCOPLASTIQUE DDI
  510.   363 continue
  511. C     MODELE VISCOPLASTIQUE KOCKS
  512.   370 continue
  513. C     MODELE VISCOPLASTIQUE NOUAILHAS_A
  514.   376 continue
  515. C     MODELE VISCOPLASTIQUE NOUAILHAS_B
  516.   377 continue
  517. C     MODELE FLUAGE COMETE
  518.   384 continue
  519. C     MODELE FLUAGE CCPL
  520.   385 continue
  521. C     MODELE FLUAGE X11
  522.   386 continue
  523. C     MODELE FLUAGE SODERBERG
  524.   402 continue
  525. C     MODELE VISCOPLASTIQUE GATT_MONERIE
  526.   407 continue
  527. C     MODELE VISCOPLASTIQUE VISCODD
  528.   430 continue
  529. C     MODELE VISCOPLASTIQUE CHAB_SINH_R
  530.   436 continue
  531. C     MODELE VISCOPLASTIQUE CHAB_SINH_X
  532.   437 continue
  533. C     MODELE VISCOPLASTIQUE CHAB_NOR_R
  534.   438 continue
  535. C     MODELE VISCOPLASTIQUE CHAB_NOR_X
  536.   439 continue
  537. C     MODELE VISCOPLASTIQUE CHABOCHE
  538.   440 continue 
  539. C
  540.       TETA1 = ture0(1)
  541.       TETA2 = turef(1)
  542.       IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN
  543.         VAR0(NVARI)=XMAT(20)
  544.       ENDIF
  545.       IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN
  546.         VAR0(NVARI-2)=XMAT(20)
  547.         VAR0(NVARI-1)=XMAT(21)
  548.         VAR0(NVARI)=XMAT(27)
  549.       ENDIF
  550.       FI1 = 0.D0
  551.       FI2 = 0.D0
  552.       IF (INPLAS.EQ.107) THEN
  553.         nexo = exova0(/1)
  554.         do 50 inex = 1,nexo
  555.           if ((nomexo(inex)          .eq.'DFIS    ').and.
  556.      &        (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  557.             fi1 = exova0(inex)
  558.             fi2 = exova1(inex)
  559.             goto 2001
  560.           endif
  561.  50     continue
  562.  2001   continue
  563.       ENDIF
  564. *
  565.       if (wrk7.eq.0) segini wrk7
  566.       if (f(/1).ne.ncourb) segadj wrk7
  567.       if (wrk9.eq.0) segini wrk9
  568.       if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA
  569.      >  .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or.
  570.      >  YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1
  571.      >  .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or.
  572.      >  YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX)
  573.      >  segadj wrk9
  574.       if (wrk91.eq.0) segini wrk91
  575.       if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  576.      >      YALFT1(/1).ne.NYALFT1 .or.
  577.      >      YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  578.      >  YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  579.      >  YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  580.      >  YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  581.      >  segadj wrk91
  582. c
  583.       iforb=ifourb
  584.       nccor = ncourb
  585.  
  586.       CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  587.      1        NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  588.      4     TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  589. c
  590.       ifourb=iforb
  591.       ncourb=nccor
  592.       IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  593.         IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  594.           CALL ERREUR(KERREU1)
  595.         ENDIF
  596.       ENDIF
  597.       DTOPTI  = MIN(DTOPTI,DTT)
  598.       NINCMA = MAX(NINCMA,NSSINC)
  599.       NCOMP = NCOMP + 1
  600.       TSOM = TSOM + DTT
  601.       NSOM = NSOM + NSSINC
  602.       NINV = NINV + INV
  603.       TCAR = TCAR + DTT* DTT
  604.       IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  605.         KERR1=1
  606.       ENDIF
  607.       RETURN
  608. C
  609. C======================================================================
  610. C     MODELE VISCOPLASTIQUE PARFAIT
  611. C======================================================================
  612.   343 CONTINUE
  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======================================================================
  636. C     MODELE VISCOPLASTIQUE 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. C======================================================================
  663. C     MODELE VISCOPLASTIQUE VISCOHINT
  664. C======================================================================
  665.   390 CONTINUE
  666. *      ELSE IF (INPLAS .EQ. 90) THEN
  667.       CALL VISHIN(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF,
  668.      &              VARF,DEFP,PRECIS,MFR1,KERRE,DT)
  669.  
  670.       IND =1
  671.       RETURN
  672. C
  673. C======================================================================
  674. C     MODELE VISCOPLASTIQUE MISTRAL
  675. C======================================================================
  676.   394 CONTINUE
  677. *      ELSE IF (INPLAS.EQ.94) THEN
  678.       FI1 = 0.D0
  679.       FI2 = 0.D0
  680.       nexo = exova0(/1)
  681.       do 60 inex = 1,nexo
  682.         if ((nomexo(inex)          .eq.'FI      ').and.
  683.      &      (conexo(inex)(1:LCONMO).eq. CONM(1:LCONMO))) then
  684.           fi1 = exova0(inex)
  685.           fi2 = exova1(inex)
  686.           goto 2002
  687.         endif
  688.  60   continue
  689.  2002 continue
  690.       CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  691.      &              NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
  692.  
  693.       IF (WR13 .EQ. 0) SEGINI,WR13
  694.       IF (NPDILT.NE.PDILT(/1) .OR. NPNBRE.NE.PNBRE(/1) .OR. 
  695.      &    NPCOHI.NE.PCOHI(/1) .OR. NPECOU.NE.PECOU(/1) .OR. 
  696.      &    NPEDIR.NE.PEDIR(/1) .OR. NPRVCE.NE.PRVCE(/1) .OR. 
  697.      &    NPECRX.NE.PECRX(/1) .OR. NPDVDI.NE.PDVDI(/1) .OR.
  698.      &    NPCROI.NE.PCROI(/1) .OR. NPINCR.NE.PINCR(/1)) SEGADJ,WR13
  699.  
  700.       CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  701.      &            NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
  702.       NDPI = nint(PNBRE(1))
  703.       NDVP = nint(PNBRE(2))
  704.       NXX  = nint(PNBRE(3))
  705.       NPSI = nint(PNBRE(4))
  706.       TETA1 = ture0(1)
  707.       TETA2 = turef(1)
  708.       CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
  709.      &            TETA2,FI2,DEPST, valmat,TXR,IDIM,
  710.      &            PDILT,NDPI,NDVP,NXX,NPSI,
  711.      &            PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  712.      &            NPINCR,PINCR,  SIGF,VARF,EPINF)
  713. C     SEGSUP WR13
  714.       IND = 1
  715.       RETURN
  716. C
  717. C======================================================================
  718. C     MODELE FLUAGE BPEL_RELAX
  719. C======================================================================
  720.   395 CONTINUE
  721. *      ELSE IF ( INPLAS .EQ. 95 ) THEN
  722. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  723.       nstrbi=nstrss
  724.       icarbi=icara
  725.       mfr1bi=mfr1
  726.       iforb=ifourb
  727.       nbgmab=nbgmat
  728.       nlmatb=nelmat
  729.       dtbi=dt
  730.       CALL ECBPEL(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  731.      1              NVARI,SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,
  732.      2              VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,
  733.      3              MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,
  734.      4              D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  735.       nstrss=nstrbi
  736.       dt=dtbi
  737.       ifourb=iforb
  738.       nelmat=nlmatb
  739.       nbgmat=nbgmab
  740.       mfr1=mfr1bi
  741.       icara=icarbi
  742.       IND = 0
  743.       RETURN
  744. C
  745. C======================================================================
  746. C     MODELES BETON_URGC
  747. C======================================================================
  748. C     MODELE PLASTIQUE BETON_URGC (DEBRANCHE POUR LE MOMENT GOTO 300)
  749.   399 CONTINUE
  750. C     MODELE VISCOPLASTIQUE BETON_URGC
  751.   400 CONTINUE
  752. C     MODELE FLUAGE BETON_URGC
  753.   401 CONTINUE
  754. C     MODELE PLASTIQUE_ENDOM BETON_URGC
  755.   420 CONTINUE
  756. C     MODELE VISCOPLASTIQUE BETON_URGC_ENDO
  757.   422 CONTINUE
  758. *      ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  759. *     1             (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN
  760. c
  761.       xlcar = bid(1)
  762.       TETA1 = ture0(1)
  763.       TETA2 = turef(1)
  764. c  modele BET_URGC : CONTRAINTES PLANES,
  765. c               DEFORMATION PLANES ET AXISYMETRIE
  766.       if (inplas.eq.100) inurgc = 1
  767. C  modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  768. C               DEFORMATION PLANES ET AXISYMETRIE
  769.       if (inplas.eq.99) inurgc = 0
  770. C  modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  771. C               DEFORMATION PLANES ET AXISYMETRIE
  772.       if (inplas.eq.101) inurgc = 2
  773. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  774. C               DEFORMATION PLANES ET AXISYMETRIE
  775.       if (inplas.eq.120) inurgc = 3
  776. C  modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  777. C               DEFORMATION PLANES ET AXISYMETRIE
  778.       if (inplas.eq.122) inurgc = 4
  779.  
  780.       nstrbi=nstrss
  781.       iforb=ifourb
  782.       dtbi=dt
  783.       CALL CURGCS(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  784.      &                xlcar,inurgc,TETA1,TETA2)
  785.       nstrss=nstrbi
  786.       ifourb=iforb
  787.       dt=dtbi
  788.       RETURN
  789. C
  790. C======================================================================
  791. C     MODELE PLASTIQUE_ENDON BETON_INSA
  792. C======================================================================
  793.   421 CONTINUE
  794. *      ELSE IF (INPLAS.EQ.121) THEN
  795. c
  796.       xlcar = bid(1)
  797. C  modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
  798.  
  799.       nstrbi=nstrss
  800.       iforb=ifourb
  801.       dtbi=dt
  802.       CALL bet3D(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  803.      &                xlcar)
  804.       nstrss=nstrbi
  805.       ifourb=iforb
  806.       dt=dtbi
  807.       RETURN
  808. C
  809. C======================================================================
  810. C     MODELES SELLIER
  811. C======================================================================
  812. C     MODELE VISCOPLASTIQUE FLUENDO3D DE SELLIER
  813. 487   CONTINUE     
  814. C     MODELE VISCOPLASTIQUE INCLUSION3D DE SELLIER
  815. 488   CONTINUE
  816. C     MODELE VISCOPLASTIQUE ENDO3D DE SELLIER
  817. 489   CONTINUE
  818. C     MODELE VISCOPLASTIQUE FLUISO3D DE SELLIER
  819. 490   CONTINUE
  820. C     MODELE VISCOPLASTIQUE FLUORTHO3D DE SELLIER
  821. 491   CONTINUE
  822. C
  823. C     RECUPERATION DES TEMPERATURES
  824.       TETA1b = ture0(1)
  825.       TETA2b = turef(1)
  826. c     nombre de composantes contraintes       
  827.       nstrbi=nstrss
  828. c     formulation       
  829.       iforb=ifourb
  830. c     pas de temps       
  831.       dtbi=dt
  832. c     nbr de variables interne       
  833.       nvarib=nvari
  834. c     nbre de noeuds ds l element
  835.       nbnnb=NBNNBI
  836. c     dimension espace       
  837.       idimb=idim
  838. c     temperature de reference
  839.       trefb=TREFA       
  840. c     coordonnees des neouds
  841. C     ENTREE : XE    : tableau de REAL*8 de dimensions (3,NBNN),
  842. C                      coordonnees des noeuds de l'element
  843. C                      Ce tableau a ete rempli par la routine DOXE
  844. C                      appelee au prealable
  845. c      do insb=1,nbnnb 
  846. c         print*,'xel(',1,insb,')=',xe(1,insb)
  847. c         print*,'xel(',2,insb,')=',xe(2,insb)
  848. c         print*,'xel(',3,insb,')=',xe(3,insb)        
  849. c      end do
  850. c      read*
  851. c      print*,'endo3d dans coml7',teta1,teta2,'endo3d'
  852. c      print*,'dans coml7'
  853.  
  854. *AM 03/04/20
  855.       if(WR14.EQ.0) then
  856.         NBVIA = 0
  857.       else
  858.         NBVIA=INLVIA(/1)
  859. c        print*,'NBVIA = ',NBVIA
  860. c        do i=1,NBVIA
  861. c           print*, 'I' ,i, 'INLVIA ' ,INLVIA(i)
  862. c        end do
  863.       endif
  864. * fin AM       
  865. * sellier       
  866.       IF (INPLAS.EQ.187) THEN
  867.         CALL cflu3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  868. c        Iecou,xecou,
  869.      #   teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  870.       ELSE IF (INPLAS.EQ.188) THEN
  871.         CALL cinc3d(WRK52,WRK53,WRK54,MWRKXE,nbnnb,idimb,
  872. c        Iecou,xecou,
  873.      #   teta1b,teta2b,nvarib,nstrbi,iforb,dtbi)
  874.       ELSE IF (INPLAS.EQ.189) THEN
  875.         CALL cndo3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  876. c        Iecou,xecou,
  877.      #   teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  878.       ELSE IF (INPLAS.EQ.190) THEN
  879. c        print*, 'coml7'
  880.         CALL cflui3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  881. c        Iecou,xecou,
  882.      #   teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  883.       ELSE IF (INPLAS.EQ.191) THEN
  884. c        print*, 'coml7'
  885.         CALL cfluo3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  886. c        Iecou,xecou,
  887.      #   teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  888.       ENDIF
  889.       nstrss=nstrbi
  890.       ifourb=iforb
  891.       dt=dtbi
  892.       nvari=nvarib
  893.       TREFA=trefb        
  894.       RETURN
  895. C
  896. C======================================================================
  897. C     MODELE VISCOPLASTIQUE LEMENDO
  898. C======================================================================
  899.   403 CONTINUE
  900. *      ELSE IF (inplas.eq.103) THEN
  901.       iforb=ifourb
  902.       nbgmab=nbgmat
  903.       nlmatb=nelmat
  904.       CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  905.      &              NLMATb,IFORB)
  906.  
  907.       ifourb=iforb
  908.       nbgmat=nbgmab
  909.       nelmat=nlmatb
  910.       RETURN
  911. C
  912. C======================================================================
  913. C     MODELE VISCOPLASTIQUE FLUNOR2
  914. C======================================================================
  915.   405 CONTINUE
  916. *      ELSE IF (inplas.eq.105) THEN
  917.       iforb=ifourb
  918.       nbgmab=nbgmat
  919.       nlmatb=nelmat
  920.       CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  921.      &              NLMATb,IFORB)
  922.       ifourb=iforb
  923.       nbgmat=nbgmab
  924.       nelmat=nlmatb
  925.       RETURN
  926. C
  927. C======================================================================
  928.       END
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  

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