Télécharger coml7.eso

Retour à la liste

Numérotation des lignes :

coml7
  1. C COML7 SOURCE FD218221 24/02/07 21:15:06 11834
  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. IF( (IDIM.EQ.2.AND.XMAT(5).EQ.0.D0).OR.
  239. + (MATE.EQ.4.AND.(MFRbi.EQ.1.OR.MFRbi.EQ.31)
  240. +.AND.IDIM.EQ.3.AND.XMAT(9).EQ.0.D0)) THEN
  241. KERRE = 33
  242. ELSE
  243. KERRE = 0
  244. ENDIF
  245. GO TO 800
  246. C
  247. C -----------------------------------------------------------------
  248. C MODELE PLASTIQUE DRUCKER_PARFAIT
  249. 303 CONTINUE
  250. c
  251. c cas du modele de drucker-prager parfait
  252. c les donnees sont les limites en traction et en compression
  253. c
  254. IMAPLA=5
  255. DEN = ABS(XMAT(6)) + XMAT(5)
  256. IF(DEN.EQ.0.D0) THEN
  257. KERRE=48
  258. ELSE
  259. XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN
  260. XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN
  261. XMAT(6) = 1.D0
  262. XMAT(8)=XMAT(5)
  263. XMAT(9)=XMAT(6)
  264. XMAT(10)=XMAT(5)
  265. XMAT(11)=XMAT(6)
  266. XMAT(12)=XMAT(7)
  267. XMAT(13)=0.D0
  268. c
  269. c petits tests sur les donnees
  270. IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  271. & XMAT(5)*1.01/(XMAT(6)+1.D-20)
  272. & .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  273. KERRE = 48
  274. ELSE
  275. KERRE = 0
  276. ENDIF
  277. ENDIF
  278. GO TO 800
  279. C
  280. C -----------------------------------------------------------------
  281. C MODELE PLASTIQUE CINEMATIQUE
  282. 304 CONTINUE
  283. c
  284. c cas de la plasticite cinematique bilineaire
  285. c
  286. IF(XMAT(5).EQ.0.D0) THEN
  287. KERRE=33
  288. ELSE
  289. ICINE=1
  290. NCOURB=2
  291. TRAC(1)=XMAT(5)
  292. TRAC(2)=0.D0
  293. TRAC(4)=1.D9
  294. TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4)
  295. ENDIF
  296. GOTO 800
  297. C
  298. C -----------------------------------------------------------------
  299. C MODELES PLASTIQUE ISOTROPE ET ELASTIQUE NON LINEAIRE
  300. 305 CONTINUE
  301. 387 CONTINUE
  302. c
  303. c cas de la plasticite isotrope ecrouissable
  304. c
  305. c on recupere la courbe de traction
  306. c
  307. nccor=ncourb
  308. CALL CCOTRA(WRK52,WRK2,NCcor,WRK53)
  309. ncourb=nccor
  310. GO TO 800
  311. C
  312. C -----------------------------------------------------------------
  313. C MODELE PLASTIQUE CHABOCHE1
  314. 307 CONTINUE
  315. KERRE = 0
  316. ICINE = 1
  317. IMAPLA= 4
  318. GO TO 800
  319. C
  320. C -----------------------------------------------------------------
  321. C MODELE PLASTIQUE CHABOCHE2
  322. 312 CONTINUE
  323. KERRE = 0
  324. ICINE = 1
  325. IMAPLA= 4
  326. GO TO 800
  327. C
  328. C -----------------------------------------------------------------
  329. C MODELE PLASTIQUE DRUCKER_PRAGER
  330. 315 CONTINUE
  331. IMAPLA=5
  332. c
  333. c petits tests sur les donnees
  334. c
  335. IF(XMAT(10)/(XMAT(11)+1.D-20).GT.
  336. 1 XMAT(5)*1.01/(XMAT(6)+1.D-20)
  337. 2 .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN
  338. KERRE = 48
  339. ELSE
  340. KERRE = 0
  341. c
  342. c permutations pour ecoinc
  343. c
  344. DO 30 I=5,7
  345. WW=XMAT(I)
  346. XMAT(I)=XMAT(I+5)
  347. XMAT(I+5)=WW
  348. 30 CONTINUE
  349. ENDIF
  350. GO TO 800
  351. C
  352. C -----------------------------------------------------------------
  353. C MODELE PLASTIQUE_ENDOM PSURY
  354. 351 CONTINUE
  355. C
  356. SEGINI ENDO0
  357. c cas de la plasticite isotrope ecrouissable avec un
  358. c endommagement de type P/Y
  359. c
  360. c on recupere la courbe de traction et la courbe de début d'endommagement
  361. nccor=ncourb
  362. CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP)
  363. ncourb=nccor
  364. IF (VAR0(7).GE.1.D-10) THEN
  365. DO 110 I=1,NSTRS
  366. SIG0(I)=SIG0(I)/VAR0(7)
  367. 110 CONTINUE
  368. ENDIF
  369. C
  370. C -----------------------------------------------------------------
  371. 800 CONTINUE
  372. IF (KERRE .NE. 0) RETURN
  373. DO 40 IC=1,ICARA
  374. WORK(IC)=XCARB(IC)
  375. 40 CONTINUE
  376. BID(1)=0.D00
  377. BID(2)=0.D00
  378. BID(3)=0.D00
  379.  
  380.  
  381. IF ((INPLAS .EQ. 1 .OR.INPLAS .EQ. 4 .OR.
  382. & INPLAS .EQ. 5 .OR.INPLAS .EQ. 7 .OR.
  383. & INPLAS .EQ. 12.OR.INPLAS .EQ. 87 ) .AND.
  384. & (MFRbi .EQ. 1 .OR. MFRbi .EQ. 3 .OR.
  385. & MFRbi .EQ. 5 .OR. MFRbi .EQ. 7 .OR.
  386. & MFRbi .EQ. 9 .OR. MFRbi .EQ. 31) .AND.
  387. & (CMATE.NE.'UNIDIREC')) THEN
  388. c
  389. nccor=ncourb
  390. iforb=ifourb
  391.  
  392. CALL CCOIN0(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  393. & NBPGAU,NCcor,IFORB,iecou)
  394. ncourb=nccor
  395. ifourb=iforb
  396. c
  397. ELSE
  398. c
  399. CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  400. & NBPGAU,ecou,necou,iecou)
  401. C
  402. C Modele d'endommagement P/Y : calcul des contraintes endommagees
  403. IF (INPLAS.EQ.51) THEN
  404. CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP,
  405. & NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  406. SEGSUP ENDO0
  407. ENDIF
  408. C
  409. ENDIF
  410. C
  411. RETURN
  412. C
  413. C======================================================================
  414. C MODELE PLASTIQUE ZERILI (Modele de Zerili-Armstrong)
  415. C======================================================================
  416. 350 CONTINUE
  417. c on recupere le pas de temps dt : voir comval
  418. c kich : fixe dt = 0. pour plasticite
  419. dtk1 = dt
  420. dt = 0.d0
  421. c
  422. IF (KERRE .EQ. 0) THEN
  423. DO 1124 IC=1,ICARA
  424. WORK(IC)=xcarb(IC)
  425. 1124 CONTINUE
  426. BID(1)=0.D00
  427. BID(2)=0.D00
  428. BID(3)=0.D00
  429. CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  430. & NBPGAU,necou,ecou,iecou,xecou)
  431. ENDIF
  432. dt = dtk1
  433. RETURN
  434. C
  435. C======================================================================
  436. C MODELES PLASTIQUE INPLAS 111, 112 et 113
  437. C======================================================================
  438. 411 CONTINUE
  439. 412 CONTINUE
  440. 413 CONTINUE
  441. C Calcula incremento de tensiones trial, DSIGT
  442. call CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,
  443. . N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,
  444. . NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  445. . XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  446. nescri =0
  447. nues =6
  448. nitmax =25
  449. precis =1.E-10
  450. C
  451. C MODELE PLASTIQUE MRS_LADE
  452. IF (INPLAS.eq.111) THEN
  453. C mrs-lade requiere siempre derivacion numerica
  454. nnumer=3
  455. deltax=2.D0**(int(log10(1.D-6)/log10(2.D0)))
  456. call eco_MRSMAC(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  457. . NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  458. . nues,nnumer,deltax,kdummy)
  459. C
  460. C MODELE PLASTIQUE J2
  461. ELSE IF (INPLAS.eq.112) THEN
  462. call eco_j2(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  463. . NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  464. . nues,kdummy)
  465. C
  466. C MODELE PLASTIQUE RH_COULOMB (Rounded Hyperbolic Mohr-Coulomb)
  467. ELSE IF (INPLAS.eq.113) THEN
  468. call eco_rhmc(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST,
  469. . NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri,
  470. . nues,kdummy)
  471. ENDIF
  472. IF (KERRE.EQ.1) THEN
  473. c write(*,*) ' Nonconvergence c7 at elem: ', ib,' gauss:',igau
  474. KERRE=99
  475. ENDIF
  476. RETURN
  477. C======================================================================
  478. C MODELES VISCOPLASTIQUE ET FLUAGE VIA CCONST
  479. C======================================================================
  480. C MODELE VISCOPLASTIQUE GUIONNET
  481. 317 continue
  482. C MODELE FLUAGE NORTON
  483. 319 continue
  484. C MODELE FLUAGE BLACKBURN
  485. 320 continue
  486. C MODELE FLUAGE POLYNOMIAL
  487. 321 continue
  488. C MODELE FLUAGE RCCMR-316
  489. 322 continue
  490. C MODELE FLUAGE RCCMR-304
  491. 323 continue
  492. C MODELE FLUAGE LEMAITRE
  493. 324 continue
  494. C MODELE VISCOPLASTIQUE ONERA
  495. 325 continue
  496. C MODELE VISCOPLASTIQUE POUDRE_A
  497. 344 continue
  498. C MODELE VISCOPLASTIQUE POUDRE_B
  499. 345 continue
  500. C MODELE VISCOPLASTIQUE OHNO
  501. 353 continue
  502. C MODELE FLUAGE BLACKBURN_2
  503. 361 continue
  504. C MODELE VISCOPLASTIQUE DDI
  505. 363 continue
  506. C MODELE VISCOPLASTIQUE KOCKS
  507. 370 continue
  508. C MODELE VISCOPLASTIQUE NOUAILHAS_A
  509. 376 continue
  510. C MODELE VISCOPLASTIQUE NOUAILHAS_B
  511. 377 continue
  512. C MODELE FLUAGE COMETE
  513. 384 continue
  514. C MODELE FLUAGE CCPL
  515. 385 continue
  516. C MODELE FLUAGE X11
  517. 386 continue
  518. C MODELE FLUAGE SODERBERG
  519. 402 continue
  520. C MODELE VISCOPLASTIQUE GATT_MONERIE
  521. 407 continue
  522. C MODELE VISCOPLASTIQUE VISCODD
  523. 430 continue
  524. C MODELE VISCOPLASTIQUE CHAB_SINH_R
  525. 436 continue
  526. C MODELE VISCOPLASTIQUE CHAB_SINH_X
  527. 437 continue
  528. C MODELE VISCOPLASTIQUE CHAB_NOR_R
  529. 438 continue
  530. C MODELE VISCOPLASTIQUE CHAB_NOR_X
  531. 439 continue
  532. C MODELE VISCOPLASTIQUE CHABOCHE
  533. 440 continue
  534. C
  535. TETA1 = ture0(1)
  536. TETA2 = turef(1)
  537. IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN
  538. VAR0(NVARI)=XMAT(20)
  539. ENDIF
  540. IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN
  541. VAR0(NVARI-2)=XMAT(20)
  542. VAR0(NVARI-1)=XMAT(21)
  543. VAR0(NVARI)=XMAT(27)
  544. ENDIF
  545. FI1 = 0.D0
  546. FI2 = 0.D0
  547. IF (INPLAS.EQ.107) THEN
  548. nexo = exova0(/1)
  549. do 50 inex = 1,nexo
  550. if ((nomexo(inex) .eq.'DFIS ').and.
  551. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  552. fi1 = exova0(inex)
  553. fi2 = exova1(inex)
  554. goto 2001
  555. endif
  556. 50 continue
  557. 2001 continue
  558. ENDIF
  559. *
  560. if (wrk7.eq.0) segini wrk7
  561. if (f(/1).ne.ncourb) segadj wrk7
  562. if (wrk9.eq.0) segini wrk9
  563. if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA
  564. > .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or.
  565. > YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1
  566. > .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or.
  567. > YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX)
  568. > segadj wrk9
  569. if (wrk91.eq.0) segini wrk91
  570. if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  571. > YALFT1(/1).ne.NYALFT1 .or.
  572. > YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  573. > YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  574. > YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  575. > YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  576. > segadj wrk91
  577. c
  578. iforb=ifourb
  579. nccor = ncourb
  580.  
  581. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  582. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  583. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  584. c
  585. ifourb=iforb
  586. ncourb=nccor
  587. IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  588. IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  589. CALL ERREUR(KERREU1)
  590. ENDIF
  591. ENDIF
  592. DTOPTI = MIN(DTOPTI,DTT)
  593. NINCMA = MAX(NINCMA,NSSINC)
  594. NCOMP = NCOMP + 1
  595. TSOM = TSOM + DTT
  596. NSOM = NSOM + NSSINC
  597. NINV = NINV + INV
  598. TCAR = TCAR + DTT* DTT
  599. IF(KERRE.NE.0.AND.KERRE.NE.99) THEN
  600. KERR1=1
  601. ENDIF
  602. RETURN
  603. C
  604. C======================================================================
  605. C MODELE VISCOPLASTIQUE PARFAIT
  606. C======================================================================
  607. 343 CONTINUE
  608. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  609. icarbi=icara
  610. dtbi=dt
  611. iforb=ifourb
  612. nlmatb=nelmat
  613. nbgmab=nbgmat
  614. mfr1bi = mfr1
  615. nstrbi=nstrss
  616. CALL PRVPAR(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  617. 1 SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  618. 2 N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  619. 3 NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  620. 4 ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  621. dt=dtbi
  622. ifourb=iforb
  623. nelmat=nlmatb
  624. nbgmat=nbgmab
  625. mfr1=mfr1bi
  626. nstrss=nstrbi
  627. IND = 0
  628. RETURN
  629. C
  630. C======================================================================
  631. C MODELE VISCOPLASTIQUE VISK2
  632. C======================================================================
  633. 382 continue
  634. * ELSE IF ( INPLAS .EQ. 82 ) THEN
  635. * les lignes en desous sont juste pour diminuer le nombre de cartes suite
  636. icarbi=icara
  637. dtbi=dt
  638. iforb=ifourb
  639. nlmatb=nelmat
  640. nbgmab=nbgmat
  641. mfr1bi = mfr1
  642. nstrbi=nstrss
  643. CALL PRVIK2(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI,
  644. 1 SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  645. 2 N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT,
  646. 3 NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  647. 4 ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi)
  648. nstrss=nstrbi
  649. dt=dtbi
  650. ifourb=iforb
  651. nelmat=nlmatb
  652. nbgmat=nbgmab
  653. mfr1=mfr1bi
  654. IND = 0
  655. RETURN
  656. C
  657. C======================================================================
  658. C MODELE VISCOPLASTIQUE VISCOHINT
  659. C======================================================================
  660. 390 CONTINUE
  661. * ELSE IF (INPLAS .EQ. 90) THEN
  662. CALL VISHIN(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF,
  663. & VARF,DEFP,PRECIS,MFR1,KERRE,DT)
  664.  
  665. IND =1
  666. RETURN
  667. C
  668. C======================================================================
  669. C MODELE VISCOPLASTIQUE MISTRAL
  670. C======================================================================
  671. 394 CONTINUE
  672. * ELSE IF (INPLAS.EQ.94) THEN
  673. FI1 = 0.D0
  674. FI2 = 0.D0
  675. nexo = exova0(/1)
  676. do 60 inex = 1,nexo
  677. if ((nomexo(inex) .eq.'FI ').and.
  678. & (conexo(inex)(1:LCONMO).eq. CONM(1:LCONMO))) then
  679. fi1 = exova0(inex)
  680. fi2 = exova1(inex)
  681. goto 2002
  682. endif
  683. 60 continue
  684. 2002 continue
  685. CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  686. & NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR)
  687.  
  688. IF (WR13 .EQ. 0) SEGINI,WR13
  689. IF (NPDILT.NE.PDILT(/1) .OR. NPNBRE.NE.PNBRE(/1) .OR.
  690. & NPCOHI.NE.PCOHI(/1) .OR. NPECOU.NE.PECOU(/1) .OR.
  691. & NPEDIR.NE.PEDIR(/1) .OR. NPRVCE.NE.PRVCE(/1) .OR.
  692. & NPECRX.NE.PECRX(/1) .OR. NPDVDI.NE.PDVDI(/1) .OR.
  693. & NPCROI.NE.PCROI(/1) .OR. NPINCR.NE.PINCR(/1)) SEGADJ,WR13
  694.  
  695. CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU,
  696. & NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13)
  697. NDPI = nint(PNBRE(1))
  698. NDVP = nint(PNBRE(2))
  699. NXX = nint(PNBRE(3))
  700. NPSI = nint(PNBRE(4))
  701. TETA1 = ture0(1)
  702. TETA2 = turef(1)
  703. CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT,
  704. & TETA2,FI2,DEPST, valmat,TXR,IDIM,
  705. & PDILT,NDPI,NDVP,NXX,NPSI,
  706. & PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI,
  707. & NPINCR,PINCR, SIGF,VARF,EPINF)
  708. C SEGSUP WR13
  709. IND = 1
  710. RETURN
  711. C
  712. C======================================================================
  713. C MODELE FLUAGE 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======================================================================
  741. C MODELES BETON_URGC
  742. C======================================================================
  743. C MODELE PLASTIQUE BETON_URGC (DEBRANCHE POUR LE MOMENT GOTO 300)
  744. 399 CONTINUE
  745. C MODELE VISCOPLASTIQUE BETON_URGC
  746. 400 CONTINUE
  747. C MODELE FLUAGE BETON_URGC
  748. 401 CONTINUE
  749. C MODELE PLASTIQUE_ENDOM BETON_URGC
  750. 420 CONTINUE
  751. C MODELE VISCOPLASTIQUE BETON_URGC_ENDO
  752. 422 CONTINUE
  753. * ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR.
  754. * 1 (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN
  755. c
  756. xlcar = bid(1)
  757. TETA1 = ture0(1)
  758. TETA2 = turef(1)
  759. c modele BET_URGC : CONTRAINTES PLANES,
  760. c DEFORMATION PLANES ET AXISYMETRIE
  761. if (inplas.eq.100) inurgc = 1
  762. C modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  763. C DEFORMATION PLANES ET AXISYMETRIE
  764. if (inplas.eq.99) inurgc = 0
  765. C modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  766. C DEFORMATION PLANES ET AXISYMETRIE
  767. if (inplas.eq.101) inurgc = 2
  768. C modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  769. C DEFORMATION PLANES ET AXISYMETRIE
  770. if (inplas.eq.120) inurgc = 3
  771. C modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES,
  772. C DEFORMATION PLANES ET AXISYMETRIE
  773. if (inplas.eq.122) inurgc = 4
  774.  
  775. nstrbi=nstrss
  776. iforb=ifourb
  777. dtbi=dt
  778. CALL CURGCS(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  779. & xlcar,inurgc,TETA1,TETA2)
  780. nstrss=nstrbi
  781. ifourb=iforb
  782. dt=dtbi
  783. RETURN
  784. C
  785. C======================================================================
  786. C MODELE PLASTIQUE_ENDON BETON_INSA
  787. C======================================================================
  788. 421 CONTINUE
  789. * ELSE IF (INPLAS.EQ.121) THEN
  790. c
  791. xlcar = bid(1)
  792. C modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D
  793.  
  794. nstrbi=nstrss
  795. iforb=ifourb
  796. dtbi=dt
  797. CALL bet3D(wrk52,wrk53,wrk54,MWRKXE,NSTRbi,IFORB,DTbi,IB,IGAU,
  798. & xlcar)
  799. nstrss=nstrbi
  800. ifourb=iforb
  801. dt=dtbi
  802. RETURN
  803. C
  804. C======================================================================
  805. C MODELES SELLIER
  806. C======================================================================
  807. C MODELE VISCOPLASTIQUE FLUENDO3D DE SELLIER
  808. 487 CONTINUE
  809. C MODELE VISCOPLASTIQUE INCLUSION3D DE SELLIER
  810. 488 CONTINUE
  811. C MODELE VISCOPLASTIQUE ENDO3D DE SELLIER
  812. 489 CONTINUE
  813. C MODELE VISCOPLASTIQUE FLUISO3D DE SELLIER
  814. 490 CONTINUE
  815. C MODELE VISCOPLASTIQUE FLUORTHO3D DE SELLIER
  816. 491 CONTINUE
  817. C
  818. C RECUPERATION DES TEMPERATURES
  819. TETA1b = ture0(1)
  820. TETA2b = turef(1)
  821. c nombre de composantes contraintes
  822. nstrbi=nstrss
  823. c formulation
  824. iforb=ifourb
  825. c pas de temps
  826. dtbi=dt
  827. c nbr de variables interne
  828. nvarib=nvari
  829. c nbre de noeuds ds l element
  830. nbnnb=NBNNBI
  831. c dimension espace
  832. idimb=idim
  833. c temperature de reference
  834. trefb=TREFA
  835. c coordonnees des neouds
  836. C ENTREE : XE : tableau de REAL*8 de dimensions (3,NBNN),
  837. C coordonnees des noeuds de l'element
  838. C Ce tableau a ete rempli par la routine DOXE
  839. C appelee au prealable
  840. c do insb=1,nbnnb
  841. c print*,'xel(',1,insb,')=',xe(1,insb)
  842. c print*,'xel(',2,insb,')=',xe(2,insb)
  843. c print*,'xel(',3,insb,')=',xe(3,insb)
  844. c end do
  845. c read*
  846. c print*,'endo3d dans coml7',teta1,teta2,'endo3d'
  847. c print*,'dans coml7'
  848.  
  849. *AM 03/04/20
  850. if(WR14.EQ.0) then
  851. NBVIA = 0
  852. else
  853. NBVIA=INLVIA(/1)
  854. c print*,'NBVIA = ',NBVIA
  855. c do i=1,NBVIA
  856. c print*, 'I' ,i, 'INLVIA ' ,INLVIA(i)
  857. c end do
  858. endif
  859. * fin AM
  860. * sellier
  861. IF (INPLAS.EQ.187) THEN
  862. CALL cflu3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  863. c Iecou,xecou,
  864. # teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  865. ELSE IF (INPLAS.EQ.188) THEN
  866. CALL cinc3d(WRK52,WRK53,WRK54,MWRKXE,nbnnb,idimb,
  867. c Iecou,xecou,
  868. # teta1b,teta2b,nvarib,nstrbi,iforb,dtbi)
  869. ELSE IF (INPLAS.EQ.189) THEN
  870. CALL cndo3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  871. c Iecou,xecou,
  872. # teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  873. ELSE IF (INPLAS.EQ.190) THEN
  874. c print*, 'coml7'
  875. CALL cflui3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  876. c Iecou,xecou,
  877. # teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  878. ELSE IF (INPLAS.EQ.191) THEN
  879. c print*, 'coml7'
  880. CALL cfluo3d(WRK52,WRK53,WRK54,MWRKXE,WR14,nbnnb,idimb,
  881. c Iecou,xecou,
  882. # teta1b,teta2b,nvarib,nstrbi,iforb,dtbi,trefb)
  883. ENDIF
  884. nstrss=nstrbi
  885. ifourb=iforb
  886. dt=dtbi
  887. nvari=nvarib
  888. TREFA=trefb
  889. RETURN
  890. C
  891. C======================================================================
  892. C MODELE VISCOPLASTIQUE LEMENDO
  893. C======================================================================
  894. 403 CONTINUE
  895. * ELSE IF (inplas.eq.103) THEN
  896. iforb=ifourb
  897. nbgmab=nbgmat
  898. nlmatb=nelmat
  899. CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  900. & NLMATb,IFORB)
  901.  
  902. ifourb=iforb
  903. nbgmat=nbgmab
  904. nelmat=nlmatb
  905. RETURN
  906. C
  907. C======================================================================
  908. C MODELE VISCOPLASTIQUE FLUNOR2
  909. C======================================================================
  910. 405 CONTINUE
  911. * ELSE IF (inplas.eq.105) THEN
  912. iforb=ifourb
  913. nbgmab=nbgmat
  914. nlmatb=nelmat
  915. CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb,
  916. & NLMATb,IFORB)
  917. ifourb=iforb
  918. nbgmat=nbgmab
  919. nelmat=nlmatb
  920. RETURN
  921. C
  922. C======================================================================
  923. END
  924.  
  925.  
  926.  

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