Télécharger coml8.eso

Retour à la liste

Numérotation des lignes :

coml8
  1. C COML8 SOURCE MB234859 23/02/03 21:15:06 11581
  2. SUBROUTINE COML8(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3. & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,
  4. & iretou,wrk12,WR12,WRKK2,wrkgur,wkumat,wcreep,
  5. & ecou,iecou,necou,xecou)
  6.  
  7. *----------------------------------------------------------------
  8. * lois locales pour la mecanique
  9. * decrites au point d integration
  10. *----------------------------------------------------------------
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC CCHAMP
  18. -INC SMMODEL
  19. -INC SMELEME
  20. -INC SMINTE
  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,NBNNbi)
  35. ENDSEGMENT
  36. *
  37. SEGMENT WRK6
  38. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  39. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  40. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  41. ENDSEGMENT
  42. *
  43. SEGMENT WRK7
  44. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  45. ENDSEGMENT
  46. *
  47. SEGMENT WRK8
  48. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  49. REAL*8 DDINVp(NSTRS,NSTRS)
  50. ENDSEGMENT
  51. *
  52. SEGMENT WRK9
  53. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  54. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  55. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  56. REAL*8 SIGY(NSIGY)
  57. INTEGER NKX(NNKX)
  58. ENDSEGMENT
  59. *
  60. SEGMENT WRK91
  61. REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  62. REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  63. REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  64. REAL*8 SIGY1(NSIGY1)
  65. ENDSEGMENT
  66. *
  67. SEGMENT WR10
  68. INTEGER IABLO1(NTABO1)
  69. REAL*8 TABLO2(NTABO2)
  70. ENDSEGMENT
  71. *
  72. SEGMENT WR12
  73. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  74. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  75. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  76. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  77. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  78. REAL*8 SM8(NSTRS)
  79. ENDSEGMENT
  80. *
  81. SEGMENT WRK12
  82. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  83. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  84. real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  85. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  86. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  87. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  88. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  89. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  90. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  91. ENDSEGMENT
  92. SEGMENT WRK22
  93. REAL*8 XXE(3,NBNNbi)
  94. ENDSEGMENT
  95.  
  96. SEGMENT WRKGUR
  97. REAL*8 WGUR1,WGUR2,WGUR3,WGUR4,WGUR5,WGUR6,WGUR7
  98. REAL*8 WGUR8,WGUR9,WGUR10,WGUR11,WGUR12(6)
  99. REAL*8 WGUR13(7), WGUR14
  100. REAL*8 WGUR15,WGUR16,WGUR17
  101. ENDSEGMENT
  102. C
  103. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  104. C l'integrateur externe specifique UMAT
  105. C
  106. SEGMENT WKUMAT
  107. C Entrees/sorties de la routine UMAT
  108. REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  109. & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  110. & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  111. & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  112. CHARACTER*16 CMNAME
  113. INTEGER NDI, NSHR, NSTATV, NPROPS,
  114. & LAYER, KSPT, KSTEP, KINC
  115. C Variables de travail
  116. LOGICAL LTEMP, LPRED, LVARI, LDFGRD
  117. INTEGER NSIG0, NPARE0, NGRAD0
  118. ENDSEGMENT
  119. C
  120. C Segment de travail pour les lois 'VISCO_EXTERNE'
  121. C
  122. SEGMENT WCREEP
  123. C Entrees/sorties constantes de la routine CREEP
  124. REAL*8 SERD
  125. CHARACTER*16 CMNAMC
  126. INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC
  127. C Entrees/sorties de la routine CREEP pouvant varier
  128. REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV),
  129. & STVP2(NSTV), STV12(NSTV), STVP3(NSTV),
  130. & STVP4(NSTV), STV13(NSTV), STVF(NSTV),
  131. & TMP12, TMP, TMP32,
  132. & DTMP12, DTMP,
  133. & PRD12(NPRD), PRD(NPRD), PRD32(NPRD),
  134. & DPRD12(NPRD), DPRD(NPRD)
  135. INTEGER KSTEPC
  136. C Autres indicateurs et variables de travail
  137. LOGICAL LTMP, LPRD, LSTV
  138. INTEGER IVIEX, NPAREC
  139. REAL*8 dTMPdt, dPRDdt(NPRD)
  140. ENDSEGMENT
  141. *
  142. REAL*8 CRIGI(12)
  143. DIMENSION NWA(9)
  144. DIMENSION SIG01(8),VAR01(37)
  145. DIMENSION EPSFLU(8)
  146.  
  147. SEGMENT ECOU
  148. REAL*8 ecow00,ecow0,
  149. C REAL*8 TEST, ALFAH,
  150. 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6),
  151. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  152. 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  153. 2 ecow12(6),
  154. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  155. 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  156. C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  157. 2 ecow17(6),ecow18(6),ecow19,ecow20
  158. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  159. ENDSEGMENT
  160. *
  161. * Segment NECOU utilisé dans ECOINC
  162. *
  163. SEGMENT NECOU
  164. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  165. . ITYP,IFOURB,IFLUAG,
  166. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  167. . JFLUAG,KFLUAG,LFLUAG,
  168. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  169. ENDSEGMENT
  170. *
  171. * Segment IECOU: sert de fourre-tout pour les initialisations
  172. * d'entiers
  173. *
  174. SEGMENT IECOU
  175. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  176. . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  177. . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  178. . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  179. . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  180. . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  181. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  182. ENDSEGMENT
  183. *
  184. * Segment XECOU: sert de fourre-tout pour les initialisations
  185. * de réels
  186. *
  187. SEGMENT XECOU
  188. REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  189. ENDSEGMENT
  190. *
  191. INTEGER WRKK2
  192. *
  193. C-----------------------------------------------------------------------
  194. C
  195. c moterr(1:6) = 'COML8 '
  196. c moterr(7:15) = 'element '
  197. c interr(1) = ib
  198. c interr(2) = igau
  199. c call erreur(-329)
  200. * write(6,*) ' entrée dans coml8 iecou ', iecou
  201. c
  202. NSSINC = 0
  203. INV = 0
  204. NBPGAU = nbgs
  205. NVARI = NVART
  206. TETA1 = ture0(1)
  207. TETA2 = turef(1)
  208. SUCC1 = -1.E35
  209. SUCC2 = -1.E35
  210. nexo = exova0(/1)
  211. if (nexo.gt.0) then
  212. do 1296 inex = 1,nexo
  213. if ((nomexo(inex)(1:4) .eq.'SUCC').and.
  214. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  215. SUCC1 = exova0(inex)
  216. SUCC2 = exova1(inex)
  217. goto 1295
  218. endif
  219. 1296 continue
  220. endif
  221. 1295 continue
  222. C
  223. jnplas = inplas + 3
  224. * inplas -2 -1 0
  225. GOTO ( 898, 899, 900,
  226. * inplas 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
  227. $ 900,302,900,900,900,900,900,900,309,900,900,900,900,314,900,
  228. $ 316,900,900,900,900,900,900,900,900,900,326,327,328,329,330,
  229. * 31
  230. $ 331,332,333,334,335,336,337,338,339,340,341,342,900,900,900,
  231. $ 900,347,348,349,900,900,352,900,354,355,356,357,358,359,360,
  232. * 61
  233. $ 900,362,900,364,365,366,367,368,369,900,371,372,373,374,375,
  234. $ 900,900,378,379,380,900,900,900,900,900,900,900,388,389,900,
  235. * 91
  236. $ 391,392,393,900,900,396,397,398,900,900,900,900,900,404,900,
  237. $ 406,900,408,900,900,900,900,900,900,900,900,900,418,419,900,
  238. * 121
  239. $ 900,900,900,900,425,900,427,428,429,900,431,432,433,434,435,
  240. $ 900,900,900,900,440,441,442,443,900,900,900,447,448,900,450,
  241. * 151 152 155 156 157 158 159 160 161 162 163 164 165
  242. $ 451,452,900,900,455,456,900,900,900,900,900,900,900,900,900,
  243. * 166 167 168 169 170 171 172 173 174
  244. $ 900,900,900,900,900,900,900,900,474
  245. $ ) JNPLAS
  246. C
  247. C======================================================================
  248. 900 CONTINUE
  249. WRITE(6,*) ' ERREUR D AIGUILLAGE COML8'
  250. CALL ERREUR (5)
  251. RETURN
  252. C
  253. C======================================================================
  254. C MODELE VISCOPLASTIQUE VISCODOMMAGE
  255. C======================================================================
  256. 329 CONTINUE
  257. ntabo1 = iablo1(/1)
  258. ntabo2 = tablo2(/1)
  259. *
  260. NYOG=IABLO1(1)
  261. NYNU=IABLO1(2)
  262. NYALFA=IABLO1(3)
  263. NYSMAX=IABLO1(4)
  264. NYN=IABLO1(5)
  265. NYM=IABLO1(6)
  266. NYKK=IABLO1(7)
  267. NYALF1=IABLO1(8)
  268. NYBET1=IABLO1(9)
  269. NYR=IABLO1(10)
  270. NYA=IABLO1(11)
  271. C
  272. INTMAT=NMATT
  273. C
  274. IF (NTABO1.EQ.INTMAT) THEN
  275. NNKX=1
  276. NYKX=IABLO1(12)
  277. ELSE
  278. NNKX=IABLO1(12)
  279. NYKX=0
  280. DO 1881 I=1,NNKX
  281. NYKX=NYKX+(2*IABLO1(12+I))
  282. 1881 CONTINUE
  283. NYKX=NYKX+NNKX
  284. ENDIF
  285. NYRHO=IABLO1(NTABO1)
  286. NSIGY=1
  287. *** SEGINI WRK9
  288. if (wrk9.eq.0) segini wrk9
  289. if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  290. > .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  291. > ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  292. > ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  293. > ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  294. > .or.nkx(/1).ne.nnkx) segadj wrk9
  295. inplas2 = INPLAS
  296. ifour2 = IFOUR
  297. mfr2 = MFRbi
  298. CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2)
  299. *** SEGSUP WR10
  300. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  301. NCOURB=2*NKX(1)
  302. ELSE
  303. NCOURB=NKX(1)
  304. DO 1882 I=1,NNKX
  305. IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  306. 1882 CONTINUE
  307. NCOURB=2*NCOURB
  308. ENDIF
  309. ** SEGINI WRK7
  310. if (wrk7.eq.0) segini wrk7
  311. if (w(/1).ne.ncourb) segadj wrk7
  312.  
  313. IF (VAR0(3).GE.0.96) THEN
  314. CALL ZDANUL(SIGF,NSTRS)
  315. DO 1883 I=1,NVARI
  316. VARF(I) = VAR0(I)
  317. 1883 CONTINUE
  318. VARF(3) = 1.D0
  319. DO 1884 I=1,NSTRS
  320. EPINF(I) = EPIN0(I)
  321. 1884 CONTINUE
  322. ELSE
  323. FI1=0.D0
  324. FI2=0.D0
  325. dtbi=dt
  326. iforb=ifourb
  327. nccor = ncourb
  328. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  329. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  330. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  331. ifourb=iforb
  332. ncourb=nccor
  333. c
  334. IF (TLIFE.GE.0.D0) THEN
  335. INTERR(1)=IB
  336. INTERR(2)=IGAU
  337. REAERR(1)=TLIFE
  338. CALL ERREUR(-279)
  339. ENDIF
  340. DTOPTI = MIN(DTOPTI,DTT)
  341. NINCMA = MAX(NINCMA,NSSINC)
  342. NCOMP = NCOMP + 1
  343. TSOM = TSOM + DTT
  344. NSOM = NSOM + NSSINC
  345. NINV = NINV + INV
  346. TCAR = TCAR + DTT* DTT
  347. IF (KERRE.NE.0) THEN
  348. KERR1=1
  349. ENDIF
  350. ENDIF
  351. RETURN
  352. C
  353. C======================================================================
  354. C MODELE VISCOPLASTIQUE PELLET
  355. C======================================================================
  356. 442 CONTINUE
  357.  
  358. ntabo1 = iablo1(/1)
  359. ntabo2 = tablo2(/1)
  360. *
  361. NYOG1=IABLO1(1)
  362. NYNU1=IABLO1(2)
  363. NYALFT1=IABLO1(3)
  364. NYSMAX1=IABLO1(4)
  365. NYN1=IABLO1(5)
  366. NYM1=IABLO1(6)
  367. NYKK1=IABLO1(7)
  368. NYALF2=IABLO1(8)
  369. NYBET2=IABLO1(9)
  370. NYR1=IABLO1(10)
  371. NYA1=IABLO1(11)
  372. NYQ1=IABLO1(12)
  373. NYRHO1=IABLO1(NTABO1)
  374. NSIGY1=1
  375. *** SEGINI WRK91
  376. if (wrk91.eq.0) segini wrk91
  377. if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  378. > YALFT1(/1).ne.NYALFT1 .or.
  379. > YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  380. > YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  381. > YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  382. > YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  383. > segadj wrk91
  384. inplas2 = INPLAS
  385. ifour2 = IFOUR
  386. mfr2 = MFRbi
  387. CALL MAT142(WR10,WRK91,inplas2,ifour2,mfr2)
  388. *** SEGSUP WR10
  389. ** SEGINI WRK7
  390. if (wrk7.eq.0) segini wrk7
  391. if (w(/1).ne.ncourb) segadj wrk7
  392. IF (VAR0(8).GE.0.96) THEN
  393. CALL ZDANUL(SIGF,NSTRS)
  394. DO I=1,NVARI
  395. VARF(I) = VAR0(I)
  396. ENDDO
  397. VARF(8) = 1.D0
  398. DO I=1,NSTRS
  399. EPINF(I) = EPIN0(I)
  400. ENDDO
  401. ELSE
  402. FI1=0.D0
  403. FI2=0.D0
  404. dtbi=dt
  405. iforb=ifourb
  406. nccor = ncourb
  407. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  408. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  409. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  410. segact necou*mod
  411. ifourb=iforb
  412. ncourb=nccor
  413. c
  414. IF (TLIFE.GE.0.D0) THEN
  415. INTERR(1)=IB
  416. INTERR(2)=IGAU
  417. REAERR(1)=TLIFE
  418. CALL ERREUR(-279)
  419. ENDIF
  420. DTOPTI = MIN(DTOPTI,DTT)
  421. NINCMA = MAX(NINCMA,NSSINC)
  422. NCOMP = NCOMP + 1
  423. TSOM = TSOM + DTT
  424. NSOM = NSOM + NSSINC
  425. NINV = NINV + INV
  426. TCAR = TCAR + DTT* DTT
  427. IF (KERRE.NE.0) THEN
  428. KERR1=1
  429. ENDIF
  430. ENDIF
  431. SEGSUP WRK7
  432. *** SEGSUP WRK91
  433. RETURN
  434. C
  435. C======================================================================
  436. C MODELE PLASTIQUE ENDOMMAGEABLE
  437. C======================================================================
  438. c modele plastique d'endommagement de lemaitre
  439. c ++++++++++++++++++++++++++++++++++++++++++++
  440. c traitement du materiau qui depend eventuellement de la temperature
  441. c ------------------------------------------------------------------
  442. 326 CONTINUE
  443. ntabo1 = iablo1(/1)
  444. ntabo2 = tablo2(/1)
  445. NYOG=IABLO1(1)
  446. NYNU=IABLO1(2)
  447. NYRHO=IABLO1(3)
  448. NYALFA=IABLO1(4)
  449. c IF ((MFRbi.EQ.1.OR.MFRbi.EQ.31.OR.MFRbi.EQ.33).AND.IFOUR.EQ.-2)
  450. c & THEN
  451. c+DC INTMAT=9
  452. c INTMAT=10
  453. c ELSE
  454. c+DC INTMAT=8
  455. c INTMAT=9
  456. c ENDIF
  457. INTMAT=NMATT
  458. IF (NTABO1.EQ.INTMAT) THEN
  459. NNKX=1
  460. NYKX=IABLO1(5)
  461. IEPS=0
  462. ELSE
  463. NNKX=IABLO1(5)
  464. NYKX=0
  465. DO 1789 I=1,NNKX
  466. NYKX=NYKX+(2*IABLO1(5+I))
  467. 1789 CONTINUE
  468. NYKX=NYKX+NNKX
  469. IEPS=1
  470. ENDIF
  471. IORIGI=6+(IEPS*NNKX)
  472. NYN=IABLO1(IORIGI)
  473. NYM=IABLO1(IORIGI+1)
  474. NYKK=IABLO1(IORIGI+2)
  475. NYSMAX=0
  476. NYALF1=0
  477. NYBET1=0
  478. NYR=0
  479. NYA=0
  480. NSIGY=0
  481. ** SEGINI WRK9
  482. if (wrk9.eq.0) segini wrk9
  483. if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  484. > .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  485. > ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  486. > ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  487. > ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  488. > .or.nkx(/1).ne.nnkx) segadj wrk9
  489. inplas2 = INPLAS
  490. ifour2 = IFOUR
  491. mfr2 = MFRbi
  492. * write(6,*) ' coml8 inplas2 ifour2 mfr2 ifourb'
  493. * write(6,*) inplas2,ifour2,mfr2,ifourb
  494. CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2)
  495. * write(6,*) ' sortier de mat29 kerre',kerre
  496. *** SEGSUP WR10
  497. c
  498. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  499. c *** on n' ecoule pas
  500. c
  501. CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  502. IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  503. DO 1115 IEN=1,NVARI
  504. VARF(IEN)=VAR0(IEN)
  505. 1115 continue
  506. VARF(3)=1.D0
  507. CALL ZDANUL(SIGF,NSTRS)
  508. CALL ZDANUL(DEFP,NSTRS)
  509. ELSE
  510. c ----------------------------------------------------------------------
  511. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  512. c p est en supplement
  513. c ----------------------------------------------------------------------
  514. NNVARI=2
  515. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  516. nccor=ncourb
  517. CALL CCOTR4(WRK52,WRK2,Nccor,WRK53)
  518. NCOURB=2*NKX(1)
  519. ELSE
  520. NCOURB=NKX(1)
  521. DO 1119 I=1,NNKX
  522. if (nkx(i).ge.ncourb) ncourb=nkx(i)
  523. 1119 CONTINUE
  524. NCOURB=4*NCOURB
  525. ENDIF
  526. IF (KERRE.EQ.0) THEN
  527. ** SEGINI WRK7
  528. if (wrk7.eq.0) segini wrk7
  529. if (w(/1).ne.ncourb) segadj wrk7
  530. trefab=trefa
  531. iforb=ifourb
  532. nccor=ncourb
  533. CALL CENDOM(wrk52,wrk53,wrk54,WRK6,WRK7,WRK8,WRK9,
  534. 1 NVARI, TETA1,TETA2,TREFAb,IB,IGAU,iforb,nccor,iecou)
  535. ifourb=iforb
  536. ncourb=nccor
  537. trefa=trefab
  538. ** SEGSUP WRK7
  539. IF (KERRE.GT.200) THEN
  540. KERR1=1
  541. ENDIF
  542. ENDIF
  543. ENDIF
  544. ** SEGSUP WRK9
  545. RETURN
  546. C
  547. C======================================================================
  548. C MODELE PLASTIQUE_ENDOM ROUSSELIER
  549. C======================================================================
  550. 362 CONTINUE
  551. c
  552. c Modèle d'endommagement de Rousselier
  553. c - on recupère la courbe de traction
  554. c
  555. nccor=ncourb
  556. CALL CCOTRA(wrk52,WRK2,NCcor,wrk53)
  557. ncourb=nccor
  558. c
  559. c - appel au modèle
  560. C
  561. IF (KERRE.EQ.0) THEN
  562. CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  563. & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  564. & necou)
  565. IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  566. KERR1=1
  567. ENDIF
  568. ENDIF
  569. RETURN
  570. C
  571. C======================================================================
  572. C MODELE PLASTIQUE_ENDOM GURSON2
  573. C======================================================================
  574. 364 CONTINUE
  575. c
  576. c Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  577. c - on recupère la courbe de traction
  578. c
  579. nccor=ncourb
  580. CALL CCOTRA(wrk52,WRK2,NCcor,wrk53)
  581. ncourb=nccor
  582. c
  583. c - appel au modèle
  584. c
  585. IF (KERRE.EQ.0) THEN
  586. CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  587. & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  588. & necou)
  589. IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  590. KERR1=1
  591. ENDIF
  592. ENDIF
  593. RETURN
  594. C
  595. C======================================================================
  596. C MODELE PLASTIQUE_ENDOM DRAGON
  597. C======================================================================
  598. 375 CONTINUE
  599. c
  600. c Modèle d'endommagement de Dragon
  601. c
  602. CALL CDRAGO(wrk52,wrk53,wrk54)
  603. RETURN
  604. C
  605. C======================================================================
  606. C MODELE PLASTIQUE_ENDOM BETON_DYNAR_LMT
  607. C======================================================================
  608. 433 CONTINUE
  609. c
  610. c Modèle viscoplastique viscoendommageable pour la dynamique rapide du LMT
  611. c
  612. CALL DYNAR(wrk52,wrk53,wrk54,iecou)
  613. RETURN
  614. C
  615. C======================================================================
  616. C MODELE ENDOMMAGEABLE MAZARS
  617. C======================================================================
  618. 330 CONTINUE
  619. c
  620. c CALL MAZZZ(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,ICARA,MFR1)
  621. CALL CMAZZZ(WRK52,WRK53,WRK54,WRKK2,NVARI,Iecou)
  622. RETURN
  623. C
  624. C======================================================================
  625. C MODELE ENDOMMAGEABLE UNILATERAL (beton)
  626. C======================================================================
  627. 331 CONTINUE
  628. c
  629. c CALL CLBBBB(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  630. c & ICARA,KERRE,MFR1,IFOURB)
  631.  
  632. CALL COLBBB(WRK52,WRK53,WRK54,NVARI,Iecou,necou)
  633. RETURN
  634. C
  635. C======================================================================
  636. C MODELE ENDOMMAGEABLE ROTATING_CRACK
  637. C======================================================================
  638. 337 continue
  639. nstrbi=nstrss
  640. icarbi=icara
  641. CALL COTATI(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  642. nstrss=nstrbi
  643. icara=icarbi
  644. RETURN
  645. C
  646. C======================================================================
  647. C MODELE ENDOMMAGEABLE SIC_SIC
  648. C======================================================================
  649. 388 CONTINUE
  650. CALL CICSIC(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  651. & ,iecou)
  652. RETURN
  653. C
  654. C======================================================================
  655. C MODELE PLASTIQUE HINT
  656. C======================================================================
  657. 389 CONTINUE
  658.  
  659. CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,xcarb,SIGF,
  660. & VARF,DEFP,PRECIS,MFR1,KERRE)
  661. RETURN
  662. C
  663. C======================================================================
  664. C MODELE ENDOMMAGEABLE MICROPLANS
  665. C======================================================================
  666. 396 CONTINUE
  667. C
  668. C MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS
  669. C
  670. CALL CMICRO(WRK52,WRK53,WRK54,NVARI,Iecou)
  671. RETURN
  672. C
  673. C======================================================================
  674. C MODELE ENDOMMAGEABLE VISCOUNILATERAL (beton)
  675. C======================================================================
  676. 397 CONTINUE
  677. icarbi=icara
  678. CALL CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  679. RETURN
  680. C
  681. C======================================================================
  682. C MODELE ENDOMMAGEABLE MICROISO
  683. C======================================================================
  684. 398 CONTINUE
  685. C
  686. C MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS
  687. C
  688. CALL CMICRI(WRK52,WRK53,WRK54,NVARI,Iecou)
  689. RETURN
  690. C
  691. C======================================================================
  692. C MODELE ENDOMMAGEABLE MVM (Modified Von Mises)
  693. C======================================================================
  694. 418 CONTINUE
  695. CALL CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  696. RETURN
  697. C
  698. C======================================================================
  699. C MODELE ENDOMMAGEABLE SICSCAL
  700. C======================================================================
  701. 431 CONTINUE
  702. CALL SICSCAL(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  703. & ,iecou)
  704. RETURN
  705. C
  706. C======================================================================
  707. C MODELE ENDOMMAGEABLE SICTENS
  708. C======================================================================
  709. 432 CONTINUE
  710. CALL SICTENS(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  711. & ,iecou)
  712. RETURN
  713. C
  714. C======================================================================
  715. C MODELE ENDOMMAGEABLE DESMORAT
  716. C======================================================================
  717. 434 CONTINUE
  718. CALL DESMOR(wrk52,wrk53,wrk54,nvari,iecou)
  719. RETURN
  720. C
  721. C======================================================================
  722. C MODELE PLASTIQUE LINESPRING
  723. C======================================================================
  724. 302 CONTINUE
  725. 327 CONTINUE
  726. CALL CLISPP(wrk52,wrk53,wrk54,WRK2,IFOUR,IB,IGAU,NBPGAU,iecou)
  727. RETURN
  728. C
  729. C======================================================================
  730. C MODELE PLASTIQUE BETON
  731. C======================================================================
  732. 309 CONTINUE
  733. CALL BETON(SIG0 ,DEPST,VAR0,XMAT,ivalma,NMATT,xcarb,
  734. 1 DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB,
  735. 2 IGAU,EPAIST,MELE,NPINT, SECT,LHOOK,
  736. 3 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,
  737. 4 SIGF,VARF,DEFP, NBPGAU,KERRE,ecou,necou,iecou)
  738. IF (KERRE.GT.200) THEN
  739. KERR1=1
  740. ENDIF
  741. RETURN
  742. C
  743. C======================================================================
  744. C MODELE PLASTIQUE TUYAU-FISSURE
  745. C======================================================================
  746. 314 CONTINUE
  747. C
  748. IF(XMAT(8).NE.0.D0 .OR. XMAT(9).NE.0.D0) THEN
  749. INPLAS=18
  750. XMAT(5)=XMAT(8)
  751. XMAT(6)=XMAT(9)
  752. xmat0(5)=xmat0(8)
  753. xmat0(6)=xmat0(9)
  754. ENDIF
  755. C
  756. iforb=ifourb
  757. CALL CTUFPL(wrk52,wrk53,wrk54,WRK2,IFORB,IB,IGAU,NBPGAU,iecou)
  758. ifourb=iforb
  759. c
  760. c pas de materiau 18 dans nomate 02/01 Kich
  761. if (inplas.eq.18) inplas = 14
  762. RETURN
  763. C
  764. C======================================================================
  765. C MODELE PLASTIQUE GAUVAIN
  766. C======================================================================
  767. 316 CONTINUE
  768. c
  769. c on recupere les courbes moment-courbure
  770. c
  771. nccor=ncourb
  772. CALL CCOTR2(wrk52,wrk53,WRK2,NCcor)
  773. ncourb=nccor
  774. IF (KERRE.NE.0) RETURN
  775. iforb=ifourb
  776. nccor=ncourb
  777. mfr1bi=mfr1
  778. nbgmab=nbgmat
  779. nlmatb=nelmat
  780. nstrbi=nstrs
  781. CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,MFR1bi,IFORB,
  782. 1 IB,IGAU,EPAIST,MELE,NPINT,NBGMAb,NLMATb,SECT,
  783. 2 LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,
  784. 3 SIG0,NSTRbi,DEPST,VAR0,XMAT,NCOMAT,xcarb,TRAC,
  785. 4 NCcor,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE)
  786. ifourb=iforb
  787. ncourb=nccor
  788. mfr1=mfr1bi
  789. nbgmat=nbgmab
  790. nelmat=nlmatb
  791. nstrs=nstrbi
  792.  
  793. IF (KERRE.GT.200) THEN
  794. KERR1=1
  795. ENDIF
  796. RETURN
  797. C
  798. C======================================================================
  799. C MODELE PLASTIQUE UBIQUITOUS
  800. C======================================================================
  801. 328 CONTINUE
  802. CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB,
  803. 1 IGAU,EPAIST,MELE,NPINT ,SECT,LHOOK,
  804. 2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,
  805. 3 DEPST,VAR0,XMAT,NBPGAU,NMATT,xcarb,DSIGT,
  806. 4 SIGF,VARF,DEFP,KERRE,ecou,necou,iecou)
  807. IF (KERRE.GT.200) THEN
  808. KERR1=1
  809. ENDIF
  810. RETURN
  811. C
  812. C======================================================================
  813. C MODELE PLASTIQUE GLOBAL
  814. C======================================================================
  815. 332 CONTINUE
  816. iforb=ifourb
  817. CALL CCOTR3(wrk52,wrk53,wrk54,IFORB,IB,IGAU,NBPGAU,iecou)
  818. ifourb=iforb
  819. IF (KERRE.LT.0) THEN
  820. INTERR(1)=IB
  821. INTERR(2)=IGAU
  822. IF (KERRE.LE.(-4)) THEN
  823. MOTERR(5:16) = 'CISAILLEMENT'
  824. CALL ERREUR(-283)
  825. KERRE = KERRE + 4
  826. ENDIF
  827. IF (KERRE.LE.(-2)) THEN
  828. MOTERR(5:16) = 'FLEXION'
  829. CALL ERREUR(-283)
  830. KERRE = KERRE + 2
  831. ENDIF
  832. IF (KERRE.LT.0) THEN
  833. MOTERR(5:16) = 'COMPRESSION'
  834. CALL ERREUR(-283)
  835. KERRE = 0
  836. ENDIF
  837. ENDIF
  838. RETURN
  839. C
  840. C======================================================================
  841. C MODELE PLASTIQUE CAM_CLAY
  842. C======================================================================
  843. 333 CONTINUE
  844. CALL CAMCLA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  845. & VARF,DEFP,PRECIS,MFR1,KERRE)
  846. RETURN
  847. C
  848. C======================================================================
  849. C MODELE PLASTIQUE COULOMB
  850. C======================================================================
  851. 334 CONTINUE
  852. c
  853. c modele de mohr coulomb pour les joints
  854. c
  855. IF (MFR.EQ.35) THEN
  856. IF (IFOUR.EQ.2) THEN
  857. c
  858. c --------------------joints 3d
  859. c
  860. CALL COUL3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  861. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  862. ELSE
  863. c
  864. c --------------------joints 2d
  865. c
  866. CALL COUL2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  867. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  868. ENDIF
  869. c
  870. c --------------------joints JOI1
  871. c
  872. ELSE IF (MFR.EQ.75) THEN
  873. CALL COUL1(IB,IGAU,NSTRS,SIG0,EPST0,EPIN0,VAR0,NVARI,DEPST,
  874. & IFOURB,XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  875. ENDIF
  876. RETURN
  877. C
  878. C======================================================================
  879. C MODELE PLASTIQUE JOINT_DILATANT
  880. C======================================================================
  881. 335 CONTINUE
  882. c
  883. c modele de coulomb_dilatant pour les joints 2d
  884. c
  885. IF (IFOUR.NE.2) THEN
  886. CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  887. ENDIF
  888. RETURN
  889. C
  890. C======================================================================
  891. C MODELE PLASTIQUE GURSON
  892. C======================================================================
  893. 338 CONTINUE
  894. nstrbi=nstrss
  895. icarbi=icara
  896. CALL PRGURS(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  897. & NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur)
  898. nstrss=nstrbi
  899. icara=icarbi
  900. RETURN
  901. C
  902. C======================================================================
  903. C MODELE PLASTIQUE BETON_AXI
  904. C======================================================================
  905. 336 CONTINUE
  906. nstrbi=nstrss
  907. CALL BETAXI(SIG0,NSTRbi,DSIGT,VAR0,XMAT,ivalma,NMATT,xcarb,
  908. & SIGF,VARF,DEFP,MFR1,KERRE,ecou,necou)
  909. nstrss=nstrbi
  910. IF (KERRE.GT.200) THEN
  911. KERR1=1
  912. ENDIF
  913. RETURN
  914. C
  915. C======================================================================
  916. C MODELE PLASTIQUE BETON_UNI
  917. C======================================================================
  918. 339 CONTINUE
  919. c
  920. c modele beton_uni pour les elements unidirectionels (barre ..)
  921. c
  922. KERR1=0
  923. CALL BARBET(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  924. RETURN
  925. C
  926. C======================================================================
  927. C MODELE PLASTIQUE UNILATERAL
  928. C======================================================================
  929. 404 CONTINUE
  930. c
  931. c modele beton unilateral pour les elements unidirectionels (barre ..)
  932. c
  933. KERR1=0
  934. CALL BARLAB(XMAT,XCARB,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  935. RETURN
  936. C
  937. C======================================================================
  938. C MODELE PLASTIQUE ACIER_ANCRAGE
  939. C======================================================================
  940. 393 CONTINUE
  941. c
  942. c modele ancrage_acier pour les elements unidirectionels (barre ..)
  943. c
  944. KERR1=0
  945. CALL BARSTA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  946. RETURN
  947. C
  948. C======================================================================
  949. C MODELE PLASTIQUE FRAGILE_UNI
  950. C======================================================================
  951. 378 CONTINUE
  952. c
  953. c modele fragile_uni pour les elements unidirectionels (barre ..)
  954. c
  955. KERR1=0
  956. CALL BARFRA(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  957. RETURN
  958. C
  959. C======================================================================
  960. C MODELE PLASTIQUE BETON_BAEL
  961. C======================================================================
  962. 379 CONTINUE
  963. c
  964. c modele beton_bael pour les elements unidirectionels (barre ..)
  965. c
  966. KERR1=0
  967. CALL BABAEL(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  968. RETURN
  969. C
  970. C======================================================================
  971. C MODELE PLASTIQUE CINEMATIQUE_ANCRAGE
  972. C======================================================================
  973. 392 CONTINUE
  974. c
  975. c
  976. c modele ancrage_parfait pour les elements unidirectionels (barre ..)
  977. c
  978. KERR1=0
  979. CALL BARPAA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  980. RETURN
  981. C
  982. C======================================================================
  983. C MODELE PLASTIQUE PARFAIT_UNI
  984. C======================================================================
  985. 380 CONTINUE
  986. c
  987. c modele parfait_uni pour les elements unidirectionels (barre ..)
  988. c
  989. KERR1=0
  990. CALL BARPAR(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  991. * IF (KERRE.NE.0) return
  992. RETURN
  993. C
  994. C======================================================================
  995. C MODELE PLASTIQUE ACIER_UNI
  996. C======================================================================
  997. 340 CONTINUE
  998. IF (MFRbi .EQ. 27) then
  999. c
  1000. c modele acier_uni pour les elements unidirectionels (barre ..)
  1001. c
  1002. KERR1=0
  1003. CALL BARSTE(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1004. C
  1005. elseif(MATE.EQ.4) then
  1006. nstrbi=nstrss
  1007. mfr1bi=mfr1
  1008. CALL CUNIAC(wrk52,wrk53,wrk54,NSTRbi,MFR1bi)
  1009. nstrss=nstrbi
  1010. mfr1=mfr1bi
  1011. C
  1012. endif
  1013. RETURN
  1014. C
  1015. C======================================================================
  1016. C MODELE PLASTIQUE SECTION
  1017. C======================================================================
  1018. 341 CONTINUE
  1019. c
  1020. c modele poutre en formulation section
  1021. c
  1022. nstrbi=nstrss
  1023. icarbi=icara
  1024. CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  1025. nstrss=nstrbi
  1026. icara=icarbi
  1027. RETURN
  1028. C
  1029. C======================================================================
  1030. C MODELE PLASTIQUE STEINBERG
  1031. C======================================================================
  1032. 349 CONTINUE
  1033. CALL STEINB(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1034. 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1035. 2 KERRE)
  1036. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1037. KERR1=1
  1038. ENDIF
  1039. RETURN
  1040. C
  1041. C======================================================================
  1042. C MODELE PLASTIQUE HUJEUX
  1043. C======================================================================
  1044. 348 CONTINUE
  1045. CALL HUJEUX(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  1046. & VARF,DEFP,PRECIS,MFR1,KERRE)
  1047. RETURN
  1048. C
  1049. C======================================================================
  1050. C MODELE PLASTIQUE OTTOSEN
  1051. C======================================================================
  1052. 342 CONTINUE
  1053. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,NMATT,
  1054. 1 xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,IB,IGAU)
  1055. RETURN
  1056. C
  1057. C======================================================================
  1058. C MODELE PLASTIQUE OTTOVARI
  1059. C======================================================================
  1060. 448 CONTINUE
  1061. IF (IFOUR.NE.2) THEN
  1062. KERRE=99
  1063. ELSE
  1064. CALL OTTVA1(NMATT,XMAT,NVARI,VAR0,NSTRSS,SIG0,DEPST,
  1065. & VARF, SIGF, KERRE)
  1066.  
  1067. ENDIF
  1068. RETURN
  1069. C
  1070. C======================================================================
  1071. C MODELE PLASTIQUE AMADEI
  1072. C======================================================================
  1073. 347 CONTINUE
  1074. c
  1075. c modele de amadei-saeb pour les joints
  1076. c
  1077. C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi
  1078. IF (IFOUR.EQ.2) THEN
  1079. c
  1080. c --------------------joints 3d
  1081. c
  1082. CALL AMADE3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  1083. & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1084. ELSE
  1085. c
  1086. c --------------------joints 2d
  1087. c
  1088. CALL AMADE2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  1089. & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1090. ENDIF
  1091. RETURN
  1092. C
  1093. C======================================================================
  1094. C MODELE PLASTIQUE PRESTON
  1095. C======================================================================
  1096. 352 CONTINUE
  1097. c
  1098. c modèle Preston-Tonks-Wallace
  1099. c
  1100. c on recupere le pas de temps dt : voir comval
  1101. c kich : fixe dt = 0. pour plasticite
  1102. dtk1 = dt
  1103. dt = 0.d0
  1104. c
  1105. CALL PRESTO(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1106. 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1107. 2 KERRE,DT)
  1108. IF (KERRE.NE.0) THEN
  1109. KERR1=1
  1110. ENDIF
  1111. dt = dtk1
  1112. RETURN
  1113. C
  1114. C======================================================================
  1115. C MODELE PLASTIQUE BETOCYCL
  1116. C======================================================================
  1117. 354 CONTINUE
  1118. c
  1119. c modele BETOCYCL
  1120. C
  1121. C ON VERIFIE LES CONTRAINTES PLANES
  1122. C
  1123. IF (IFOUR.EQ.-2) THEN
  1124. C
  1125. C ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION
  1126. C
  1127. IPOS1=1
  1128. CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1129. NTRAT=NPOINT/2
  1130. IPOS2=IPOS1+NPOINT
  1131. CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1132. NTRAC=NPOINT/2
  1133. IF (KERRE.EQ.0) THEN
  1134. CALL CBETOC(wrk52,wrk53,wrk54,WRK2,NTRAT,NTRAC)
  1135. ENDIF
  1136. ELSE
  1137. KERRE = 99
  1138. ENDIF
  1139. RETURN
  1140. C
  1141. C======================================================================
  1142. C MODELE PLASTIQUE ROTATING_CRACK
  1143. C======================================================================
  1144. 355 CONTINUE
  1145. C
  1146. C ON VERIFIE LES CONTRAINTES PLANES
  1147. C
  1148. IF (IFOUR.EQ.-2) THEN
  1149. IF (KERRE.EQ.0) THEN
  1150. CALL CROTAT(wrk52,wrk53,wrk54)
  1151. ENDIF
  1152. ELSE
  1153. KERRE = 99
  1154. ENDIF
  1155. RETURN
  1156. C
  1157. C======================================================================
  1158. C MODELE PLASTIQUE JOINT_SOFT
  1159. C======================================================================
  1160. 356 CONTINUE
  1161. C
  1162. C ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR
  1163. C
  1164. C
  1165. C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est
  1166. C 6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1167. C 'ALFA' a la place 3 et 4 dans defmat.eso
  1168. C
  1169. IPOS1=1
  1170. CALL COTRAJ(wrk52,wrk53,WRK2,8, IPOS1,1, NPOINT)
  1171. NTRAC=NPOINT/2
  1172. IPOS2=IPOS1+NPOINT
  1173. CALL COTRAJ(wrk52,wrk53,WRK2,9, IPOS2,1, NPOINT)
  1174. NTRAS=NPOINT/2
  1175. IPOS3=IPOS2+NPOINT
  1176. CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS3,1, NPOINT)
  1177. NTRAT=NPOINT/2
  1178. C
  1179. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1180. IF(KERRE.EQ.0) THEN
  1181. C
  1182. CALL SJONL2(SIG0,DEPST,VAR0,XMAT,
  1183. . TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS,
  1184. . TRAC(IPOS3),NTRAT,
  1185. . SIGF,VARF,DEFP,KERRE)
  1186. END IF
  1187. ELSEIF(IFOUR.EQ.2)THEN
  1188. IF(KERRE.EQ.0) THEN
  1189. C
  1190. CALL SJONL3(SIG0,DEPST,VAR0,XMAT,
  1191. . TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT,
  1192. . TRAC(IPOS3),NTRAC,
  1193. . SIGF,VARF,DEFP,KERRE)
  1194. END IF
  1195. END IF
  1196. RETURN
  1197. C
  1198. C======================================================================
  1199. C MODELE PLASTIQUE JOINT_COAT
  1200. C======================================================================
  1201. 419 CONTINUE
  1202. C
  1203. C ON RECUPERE LA COURBE DE SHEAR
  1204. C
  1205. C Note: La courbe a maintenant l'indices 4 alors que c'est
  1206. C 2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1207. C 'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...)
  1208. C
  1209. IPOS1=1
  1210. CALL COTRAJ(wrk52,wrk53,WRK2,4,IPOS1,1, NPOINT)
  1211. NTRAS=NPOINT/2
  1212. C
  1213. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1214. IF(KERRE.EQ.0) THEN
  1215. C
  1216. CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS,
  1217. . SIGF,VARF,DEFP,KERRE)
  1218. END IF
  1219. ELSEIF(IFOUR.EQ.2)THEN
  1220. IF(KERRE.EQ.0) THEN
  1221. END IF
  1222. END IF
  1223. RETURN
  1224. C
  1225. C======================================================================
  1226. C MODELE ENDOMMAGEABLE DAMAGE_TC
  1227. C======================================================================
  1228. 425 CONTINUE
  1229. IF(MFR.EQ.1)THEN
  1230. CALL DAMATC(IFOUR,XMAT,DDHOOK,LHOOK,SIG0,VAR0,
  1231. & DEPST,DSIGT,EPST0,EPIN0, SIGF,VARF,DEFP,
  1232. & XMAT0,DDAUX)
  1233. ENDIF
  1234. RETURN
  1235. C
  1236. C======================================================================
  1237. C MODELE PLASTIQUE_ENDOM ENDO_PLAS
  1238. C======================================================================
  1239. 435 CONTINUE
  1240. CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0,
  1241. & SIGF,DEPST,NSTRS,KERRE,ISTEP)
  1242. RETURN
  1243. C
  1244. C======================================================================
  1245. C MODELE PLASTIQUE MUR_SHEAR (DEBRANCHE)
  1246. C======================================================================
  1247. 426 CONTINUE
  1248. C
  1249. C POUR LE MOMENT, ELEMENT DE POUTRE
  1250. C MAIS ON AJOUTE MAINTENANT LE MACRO ELEMENT
  1251. C
  1252. IF(MFR.EQ.7.OR.MFR.EQ.61)THEN
  1253. C
  1254. C ON RECUPERE LES COURBES
  1255. C
  1256. C Note: Les courbes ont maintenant les indices 5 a 10 alors que
  1257. C c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a
  1258. C incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso
  1259. C
  1260. IPOS1=1
  1261. CALL COTRAJ(wrk52,wrk53,WRK2, 5,IPOS1,0, NPOINT)
  1262. NCURFP=NPOINT/2
  1263. IPOS2=IPOS1+NPOINT
  1264. CALL COTRAJ(wrk52,wrk53,WRK2, 6,IPOS2,0, NPOINT)
  1265. NCURKP=NPOINT/2
  1266. IPOS3=IPOS2+NPOINT
  1267. CALL COTRAJ(wrk52,wrk53,WRK2, 7,IPOS3,0, NPOINT)
  1268. NCURLP=NPOINT/2
  1269. IPOS4=IPOS3+NPOINT
  1270. CALL COTRAJ(wrk52,wrk53,WRK2, 8,IPOS4,0, NPOINT)
  1271. NCURFM=NPOINT/2
  1272. IPOS5=IPOS4+NPOINT
  1273. CALL COTRAJ(wrk52,wrk53,WRK2, 9,IPOS5,0, NPOINT)
  1274. NCURKM=NPOINT/2
  1275. IPOS6=IPOS5+NPOINT
  1276. CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS6,0, NPOINT)
  1277. NCURLM=NPOINT/2
  1278. C
  1279. IF(KERRE.EQ.0) THEN
  1280. C+PPM
  1281. IF(MFR.EQ.7)THEN
  1282. C+PPM
  1283. CALL MSHETI(wrk52,wrk53,WRK2,
  1284. > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1285. > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6,
  1286. > KERR2)
  1287. KERRE = KERR2
  1288. C+PPM
  1289. ELSE
  1290. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1291. CCC CALL MASHEJ(wrk52,wrk53,WRK2,
  1292. CCC > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1293. CCC > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6)
  1294. ELSE
  1295. KERRE=99
  1296. ENDIF
  1297. ENDIF
  1298. C+PPM
  1299. END IF
  1300. END IF
  1301. RETURN
  1302. C
  1303. C======================================================================
  1304. C MODELE PLASTIQUE ANCRAGE_ELIGEHAUSEN
  1305. C======================================================================
  1306. 391 CONTINUE
  1307. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1308. CALL ANCREL(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  1309. ENDIF
  1310. RETURN
  1311. C
  1312. C======================================================================
  1313. C MODELE PLASTIQUE BILI_MOMY
  1314. C======================================================================
  1315. 357 CONTINUE
  1316. KERRE=0
  1317. CALL BILIPO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1318. RETURN
  1319. C
  1320. C======================================================================
  1321. C MODELE PLASTIQUE BILI_EFFZ
  1322. C======================================================================
  1323. 358 CONTINUE
  1324. KERRE=0
  1325. CALL BILIFO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1326. RETURN
  1327. C
  1328. C======================================================================
  1329. C MODELE PLASTIQUE TAKEMO_MOMY
  1330. C======================================================================
  1331. 359 CONTINUE
  1332. C
  1333. C ON RECUPERE LES COURBES MOMENT-COURBURE
  1334. C
  1335. nccor=ncourb
  1336. CALL COTRAF(wrk52,wrk53,WRK2,NCcOR)
  1337. ncourb=nccor
  1338. IF (KERRE.EQ.0) THEN
  1339. C
  1340. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1341. CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1342. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1343. ELSE
  1344. CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1345. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1346. ENDIF
  1347. ENDIF
  1348. RETURN
  1349. C
  1350. C======================================================================
  1351. C MODELE PLASTIQUE BA1D
  1352. C======================================================================
  1353. 447 CONTINUE
  1354. CALL BA1D(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1355. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1356.  
  1357. RETURN
  1358. C
  1359. C======================================================================
  1360. C MODELE PLASTIQUE TAKEMO_EFFZ
  1361. C======================================================================
  1362. 360 CONTINUE
  1363. C
  1364. C ON RECUPERE LES COURBES MOMENT-COURBURE
  1365. C
  1366. nccor=ncourb
  1367. CALL COTRAF(wrk52,wrk53,WRK2,NCcor)
  1368. ncourb=nccor
  1369. IF (KERRE.EQ.0) THEN
  1370. C
  1371. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1372. CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1373. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1374. ELSE
  1375. CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1376. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1377. ENDIF
  1378. C
  1379. ENDIF
  1380. RETURN
  1381. C
  1382. C======================================================================
  1383. C MODELE PLASTIQUE DRUCKER_PRAGER2
  1384. C======================================================================
  1385. 440 CONTINUE
  1386. XLCARA=0.D0
  1387. NEXO = EXOVA0(/1)
  1388. DO INEX=1,NEXO
  1389. IF ((NOMEXO(INEX)(1:4) .EQ.'LCAR').AND.
  1390. & (CONEXO(INEX)(1:LCONMO).EQ.CONM(1:LCONMO))) THEN
  1391. XLCARA=EXOVA0(INEX)
  1392. ENDIF
  1393. ENDDO
  1394. CALL DRUCK2(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVALMA,
  1395. & NMATT,XCARB,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  1396. & IB,IGAU,IFOURB,XLCARA,MELE)
  1397. RETURN
  1398. C
  1399. C======================================================================
  1400. C MODELE ENDOMMAGEABLE FATSIN
  1401. C======================================================================
  1402. 441 CONTINUE
  1403.  
  1404. * Fatigue damage model (fatsin)
  1405. * print*,'appel a cfattt dans coml8'
  1406. CALL CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou)
  1407. RETURN
  1408. C
  1409. C======================================================================
  1410. C MODELE PLASTIQUE BETON_INSA
  1411. C======================================================================
  1412. 366 CONTINUE
  1413. C
  1414. C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES,
  1415. C DEFORMATION PLANES ET AXISYMETRIE
  1416. C
  1417. nstrbi=nstrss
  1418. iwpoi1=wrk12
  1419. CALL BEINSA(SIG0,NSTRbi,DEPST,VAR0,XMAT,ivalma,NMATT,SIGF,VARF,
  1420. 1 KERRE,MELE,IFOURB,NVARI,xcarb,NCARR,MFRbi,EPIN0,
  1421. 2 EPINF,DT,XE,NBNNbi,CMATE,IB,IGAU,iwpoi1)
  1422. RETURN
  1423. C
  1424. C======================================================================
  1425. C MODELE PLASTIQUE ECROUIS_DECOU
  1426. C======================================================================
  1427. 367 CONTINUE
  1428. C
  1429. C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE)
  1430. C
  1431. MVEL1= nint(XMAT(NMATR) )
  1432. nccor=ncourb
  1433. CALL CCOTRO(wrk52,wrk53,WRK2,NCcor,MVEL1)
  1434. ncourb=nccor
  1435. LT1=NCOURB*2
  1436. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1437. & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB)
  1438. RETURN
  1439. C
  1440. C======================================================================
  1441. C MODELE PLASTIQUE PARFAIT_DECOU
  1442. C======================================================================
  1443. 368 CONTINUE
  1444. C
  1445. C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE)
  1446. C
  1447. NCOURB=3
  1448. KERRE = 0
  1449. TRAC(1)=0.D0
  1450. TRAC(2)=0.D0
  1451. TRAC(3)=XMAT(NMATR)
  1452. TRAC(4)=XMAT(NMATR)/XMAT(1)
  1453. TRAC(5)=XMAT(NMATR)
  1454. TRAC(6)=1.D0
  1455. IF (XMAT(NMATR).EQ.0.D0) KERRE = 33
  1456. LT1=NCOURB*2
  1457. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1458. & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB)
  1459. RETURN
  1460. C
  1461. C======================================================================
  1462. C MODELE PLASTIQUE ALONSO
  1463. C======================================================================
  1464. 369 CONTINUE
  1465. C
  1466. C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO
  1467. C
  1468. ****************************
  1469. * SPECIAL SUCCION
  1470. *
  1471. CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1472. & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou)
  1473. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1474. KERR1=1
  1475. ENDIF
  1476. RETURN
  1477. C
  1478. C======================================================================
  1479. C MODELE PLASTIQUE PAKZAD
  1480. C======================================================================
  1481. 371 CONTINUE
  1482. C
  1483. C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD
  1484. C
  1485. CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1486. & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou)
  1487. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1488. KERR1=1
  1489. ENDIF
  1490. RETURN
  1491. C
  1492. C======================================================================
  1493. C MODELE PLASTIQUE INFILL_UNI
  1494. C======================================================================
  1495. 372 CONTINUE
  1496. IF (MFRbi.EQ.27) THEN
  1497. C
  1498. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1499. C
  1500. CALL COTRAJ(wrk52,wrk53,WRK2,12,1,0, NPOINT)
  1501. NCOURB=NPOINT/2
  1502. IF (KERRE.EQ.0) THEN
  1503. nccor=ncourb
  1504. CALL CINFIL(wrk52,wrk53,wrk54,WRK2,NCcor)
  1505. ncourb=nccor
  1506. ENDIF
  1507. ELSE
  1508. KERRE = 99
  1509. ENDIF
  1510. RETURN
  1511. C
  1512. C======================================================================
  1513. C MODELE PLASTIQUE CISAIL_NL
  1514. C======================================================================
  1515. 373 CONTINUE
  1516. C
  1517. C MODELE ETAGE
  1518. C pour le moment, element de barre
  1519. *
  1520. IF (MFRbi.EQ.7) THEN
  1521. C
  1522. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1523. C
  1524. IPOS1=1
  1525. CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1526. NTRAP=NPOINT/2
  1527. IPOS2=IPOS1+NPOINT
  1528. CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1529. NTRAN=NPOINT/2
  1530. IF (KERRE.EQ.0) THEN
  1531. CALL CETAG(wrk52,wrk53,wrk54,WRK2,NTRAP,NTRAN)
  1532. ENDIF
  1533. ELSE
  1534. KERRE = 99
  1535. ENDIF
  1536. RETURN
  1537. C
  1538. C======================================================================
  1539. C MODELE FLUAGE CERAMIQUE
  1540. C======================================================================
  1541. *---------------------------------------------------------------------
  1542. * ceramique caroline, couplage gatt_monerie ottosen,
  1543. * maxwell, couplage maxwell ottosen
  1544. *---------------------------------------------------------------------
  1545. 365 CONTINUE
  1546. *
  1547. IF ((MFRbi.EQ.1).AND.(IFOMOD.EQ.2)) THEN
  1548. IBIDO = 19
  1549. ELSE
  1550. IBIDO = 14
  1551. ENDIF
  1552. *
  1553. * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION
  1554. * CAD LORSQUE TTRAN = 0
  1555. *
  1556. IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN
  1557. *
  1558. * si le point de gauss est déjà endommagé par endommagement généralisé
  1559. * on le traite simplement par ccerac
  1560. *
  1561. IF (VAR0(NVARI-1).EQ.1) THEN
  1562. iforb=ifourb
  1563. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1564. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1565. IND=1
  1566. ELSE
  1567. *
  1568. * si le point de gauss n'a pas un endommagement généralisé
  1569. * on regarde si il a été fissuré
  1570. * par ottosen et si non on applique le fluage puis ottosen
  1571. * si oui on le traite par ottosen
  1572. *
  1573. CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1574. IF (ITOTO.EQ.0) THEN
  1575. iforb=ifourb
  1576. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1577. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1578. ifourb=iforb
  1579. IND=1
  1580. * Ligne suivante à supprimer
  1581. * IF (IND.EQ.0) THEN
  1582. * on regarde si on a eu endommagement généralisé
  1583. * si on n'a pas eu endommagement généralisé on appelle ottosen
  1584. IF (VARF(NVARI-1).NE.1) THEN
  1585. DO 161 I = 1,NVARI
  1586. VAR01(I) = VARF(I)
  1587. 161 CONTINUE
  1588. DO 835 I=1,NSTRS
  1589. * PRINT *,'DEPST EPINF-EPIN0 ',
  1590. * 1 I,DEPST(I),(EPINF(I)-EPIN0(I))
  1591. DEPST(I) = DEPST(I) - (EPINF(I)-EPIN0(I))
  1592. C on remplace SIGF par SIG0
  1593. SIG01(I) = SIG0(I)
  1594. 835 CONTINUE
  1595. CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,
  1596. 1 ivalma,NMATT,xcarb,ICARA,NVARI,SIGF,VARF,
  1597. 2 DEFP,MFR1,KERRE,IB,IGAU)
  1598. C on met à jour la variable interne EPSE commune aux deux modèles
  1599. VARF(1) = VARF(1)+VARF(NVARI)
  1600. C DO 537 I=1,NSTRS
  1601. C IF (SIGF(I).NE.SIG01(I)) THEN
  1602. C PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I)
  1603. C ENDIF
  1604. C537 CONTINUE
  1605. C DO 538 I=1,NVARI
  1606. C IF (VARF(I).NE.VAR01(I)) THEN
  1607. C PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I)
  1608. C ENDIF
  1609. C 538 CONTINUE
  1610.  
  1611. C on calcule l'increment de déformation du pas de temps
  1612. DO 836 I=1,NSTRS
  1613. C IF (DEFP(I).NE.0.) PRINT *,'DEFP',DEFP(I)
  1614. DEFP(I) = DEFP(I)+(EPINF(I)-EPIN0(I))
  1615. 836 CONTINUE
  1616. IND=0
  1617. ENDIF
  1618. ELSE
  1619. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1620. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1621. 2 KERRE,IB,IGAU)
  1622. VARF(1) = VARF(1)+VARF(NVARI)
  1623. IND=0
  1624. ENDIF
  1625. ENDIF
  1626. C
  1627. ELSE
  1628. *
  1629. * CAS OU ON PREND EN COMPTE LA TEMPERATURE DE TRANSITION
  1630. *
  1631. IF (TETA2.GE.XMAT(IBIDO)) THEN
  1632. CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1633. IF (ITOTO.EQ.0) THEN
  1634. iforb=ifourb
  1635. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1636. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1637. ifourb=iforb
  1638. IND=1
  1639. ELSE
  1640. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1641. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1642. 2 KERRE,IB,IGAU)
  1643. VARF(1) = VARF(1)+VARF(NVARI)
  1644. IND=0
  1645. ENDIF
  1646. ELSE
  1647. IF (VAR0(NVARI-1).EQ.1) THEN
  1648. iforb=ifourb
  1649. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1650. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1651. ifourb=iforb
  1652. IND=1
  1653. ELSE
  1654. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1655. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1656. 2 KERRE,IB,IGAU)
  1657. VARF(1) = VARF(1)+VARF(NVARI)
  1658. IND=0
  1659. ENDIF
  1660. ENDIF
  1661. ENDIF
  1662. IF (MFR1.EQ.17) THEN
  1663. IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  1664. CALL ERREUR(KERREU1)
  1665. ENDIF
  1666. ENDIF
  1667. C
  1668. DTOPTI = MIN(DTOPTI,DTT)
  1669. NINCMA = MAX(NINCMA,NSSINC)
  1670. NCOMP = NCOMP + 1
  1671. TSOM = TSOM + DTT
  1672. NSOM = NSOM + NSSINC
  1673. NINV = NINV + INV
  1674. TCAR = TCAR + DTT* DTT
  1675. IF (KERRE.NE.0.AND.KERRE.NE.99) THEN
  1676. KERR1=1
  1677. ENDIF
  1678. RETURN
  1679. C
  1680. C======================================================================
  1681. C MODELE VISCOPLASTIQUE UO2
  1682. C======================================================================
  1683. 408 CONTINUE
  1684. C
  1685. IND=0
  1686. FI1 = 0.D0
  1687. FI2 = 0.D0
  1688. nexo = exova0(/1)
  1689. do 2050 inex = 1,nexo
  1690. if ((nomexo(inex)(1:4).eq.'DFIS').and.
  1691. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  1692. fi1 = exova0(inex)
  1693. fi2 = exova1(inex)
  1694. goto 2001
  1695. endif
  1696. 2050 continue
  1697. 2001 continue
  1698. C
  1699. C NSIMP pointe sur la caracteristique de fissuration facult. qui
  1700. C indique le type de resolution souhaite
  1701. C
  1702. IF (IFOMOD.EQ.2.AND.MFR1.EQ.1) THEN
  1703. NSIMP=71
  1704. ELSE
  1705. NSIMP=66
  1706. IF(MFR1.EQ.1.AND.IFOUR.EQ.-2) NSIMP=62
  1707. IF(MFR1.EQ.3.OR.MFR1.EQ.9) NSIMP=61
  1708. ENDIF
  1709. XSIMP=XMAT(NSIMP)
  1710. C
  1711. IF (XSIMP.EQ.0.D0) THEN
  1712. C resolution complete
  1713. C
  1714. CALL UO2OTO(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1715. 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1716. 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1717. ELSE
  1718. C resolution simplifiee
  1719. C
  1720. CALL UO2OT2(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1721. 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1722. 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1723. ENDIF
  1724. IF (KERRE.NE.0.AND.KERRE.NE.99) KERR1=1
  1725. RETURN
  1726. C
  1727. C======================================================================
  1728. C MODELE FLUAGE MAXWELL
  1729. C======================================================================
  1730. 374 CONTINUE
  1731. *
  1732. * CHAINE DE MAXWELL
  1733. *
  1734. * on commence par recuperer le nombre d'elements dans la chaine
  1735. * et les proprietes et variables internes associees a des objets
  1736. *
  1737. nbgmab=nbgmat
  1738. nlmatb=nelmat
  1739. CALL CMAXTA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMbT,NLMATb,NWA,
  1740. & NCHAIN)
  1741. nbgmat=nbgmab
  1742. nelmat=nlmatb
  1743. IF (IERR.NE.0) THEN
  1744. SEGSUP WR12
  1745. return
  1746. ENDIF
  1747. C
  1748. IF (MFRbi.EQ.3.OR.MFRbi.EQ.39) THEN
  1749. dtbi=dt
  1750. CALL CMAXGE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1751. dt=dtbi
  1752. ELSE
  1753. C
  1754. *
  1755. * MLR 10/08/99
  1756. *
  1757. * ON PASSE LE SEGMENT DE TRAVAIL WTRAV
  1758. dtbi=dt
  1759. CALL CMAXWE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1760. dt=dtbi
  1761. ENDIF
  1762. *
  1763. * ici gerer les erreurs
  1764. *
  1765. CALL CMAXTB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN)
  1766. C SEGSUP WR12
  1767. RETURN
  1768. C
  1769. C======================================================================
  1770. C MODELE FLUAGE MAXOTT
  1771. C======================================================================
  1772. 406 CONTINUE
  1773. *
  1774. * on commence par recuperer le nombre d'elements dans la chaine
  1775. * et les proprietes et variables internes associees a des objets
  1776. *
  1777. nbgmab=nbgmat
  1778. nlmatb=nelmat
  1779. CALL CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAb,NLMATb,NWA,
  1780. & NCHAIN,EPSFLU)
  1781. nbgmat=nbgmab
  1782. nelmat=nlmatb
  1783. IF (IERR.NE.0) THEN
  1784. SEGSUP WR12
  1785. RETURN
  1786. ENDIF
  1787. *
  1788. * modele maxott
  1789. *
  1790. dtbi=dt
  1791. CALL CMAXOT(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA,
  1792. & EPSFLU)
  1793. dt=dtbi
  1794. *
  1795. * stockage des variables internes et des proprietes
  1796. *
  1797. CALL CMAXOB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN,EPSFLU)
  1798. C SEGSUP WR12
  1799. RETURN
  1800. C
  1801. C======================================================================
  1802. C MODELES FLUAGE FBB1 ET FBB2
  1803. C======================================================================
  1804. 427 CONTINUE
  1805. 428 CONTINUE
  1806. LEPLAS = INPLAS
  1807. CALL CFBB(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU,IECOU,LEPLAS)
  1808. RETURN
  1809. C
  1810. C======================================================================
  1811. C MODELE PLASTIQUE INCO
  1812. C======================================================================
  1813. 429 CONTINUE
  1814. CALL INCO(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1815. RETURN
  1816. C
  1817. C======================================================================
  1818. C MODELE FLUAGE KELVIN
  1819. C======================================================================
  1820. 474 CONTINUE
  1821. CALL KELVIN (wrk52,wrk53,wrk54,IB,IGAU,NBPGAU)
  1822. RETURN
  1823. C
  1824. C======================================================================
  1825. C MODELE VISCOPLASTIQUE FLUTRA
  1826. C======================================================================
  1827. 443 CONTINUE
  1828. NMATER = NMATT + 3
  1829. LWTRA = NMATER + (8*NSTRS) + (3*NSTRS*NSTRS)
  1830. IF(LW.LT.LWTRA) THEN
  1831. LW = LWTRA
  1832. SEGADJ WRK3
  1833. ENDIF
  1834. *
  1835. LA1 = 1
  1836. LA2 = LA1 + NMATER
  1837. LA3 = LA2 + NSTRS
  1838. LA4 = LA3 + NSTRS
  1839. LA5 = LA4 + NSTRS
  1840. LA6 = LA5 + NSTRS*NSTRS
  1841. LA7 = LA6 + NSTRS
  1842. LA8 = LA7 + NSTRS
  1843. LA9 = LA8 + NSTRS
  1844. LA10 = LA9 + NSTRS
  1845. LA11 = LA10 + NSTRS
  1846. LA12 = LA11 + NSTRS*NSTRS
  1847. *
  1848. CALL FLUTRA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NMATT,
  1849. & IFOUR,DT,IB,IGAU,TETA1,TETA2,ITHER,NMATER,
  1850. & SIGF,VARF,WORK(LA1),WORK(LA2),WORK(LA3),
  1851. & WORK(LA4),WORK(LA5),WORK(LA6),WORK(LA7),
  1852. & WORK(LA8),WORK(LA9),WORK(LA10),WORK(LA11),
  1853. & WORK(LA12),KERRE)
  1854. RETURN
  1855. C
  1856. C======================================================================
  1857. C MODELE PLASTIQUE BILIN_EFFX
  1858. C======================================================================
  1859. 450 CONTINUE
  1860. KERRE=0
  1861. CALL BREVA1(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1862. RETURN
  1863. C
  1864. C======================================================================
  1865. C MODELE PLASTIQUE ISS_GRANGE
  1866. C======================================================================
  1867. 451 CONTINUE
  1868. KERRE=0
  1869. CALL ISSGRA(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1870. IF (KERRE.EQ.22) THEN
  1871. INTERR(1)=IB
  1872. MOTERR(1:4) = 'JOI1'
  1873. INTERR(2)=IGAU
  1874. INTERR(3)=INPLAS
  1875. CALL ERREUR(268)
  1876. ENDIF
  1877. IF (KERRE.EQ.23) THEN
  1878. CALL ERREUR(1016)
  1879. ENDIF
  1880. IF (KERRE.EQ.25) THEN
  1881. CALL ERREUR(1017)
  1882. ENDIF
  1883. RETURN
  1884. C
  1885. C======================================================================
  1886. C MODELE PLASTIQUE RUP_THER
  1887. C======================================================================
  1888. 452 CONTINUE
  1889. KERRE=0
  1890. CALL RUPTHE(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1891. IF (KERRE.EQ.22) THEN
  1892. INTERR(1)=IB
  1893. MOTERR(1:4) = 'JOI1'
  1894. INTERR(2)=IGAU
  1895. INTERR(3)=INPLAS
  1896. CALL ERREUR(268)
  1897. ENDIF
  1898. RETURN
  1899. C
  1900. C======================================================================
  1901. C MODELE PLASTIQUE GERNAY
  1902. C======================================================================
  1903. 455 CONTINUE
  1904. KERRE=0
  1905. CALL GERNAY(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU)
  1906. RETURN
  1907. C
  1908. C======================================================================
  1909. C MODELE PLASTIQUE WELLS
  1910. C======================================================================
  1911. 456 CONTINUE
  1912. CALL WELLS(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU)
  1913. RETURN
  1914. C
  1915. C======================================================================
  1916. C MODELE ELASTIQUE NON_LINEAIRE UTILISATEUR
  1917. C======================================================================
  1918. C Modele 'NON_LINEAIRE' 'UTILISATEUR' : integrateur externe
  1919. C specifique UMAT
  1920. C-----------------------------------------------------------------------
  1921. 899 CONTINUE
  1922. C
  1923. KERR1 = 0
  1924. C
  1925. C Pointeur (>0) sur fonction externe si definie
  1926. m_ptre = wrk53.jecher
  1927. C
  1928. C Preparation des entrees de la routine UMAT
  1929. C N.B. Les arguments pointeurs sont reperes par des
  1930. C caracteres minuscules
  1931. C
  1932. CALL WKUMA1 ( wrk52, wkumat )
  1933. C
  1934. C Integration de la loi externe au point courant
  1935. C N.B. Les entrees/sorties non actives ou non exploitees sont
  1936. C reperees par des caracteres minuscules
  1937. C
  1938. IF (m_ptre.LE.0) THEN
  1939. C
  1940. C Appel a UMAT standard de Cast3M
  1941. CALL UMAT ( SIGF, VARF, ddsdde, sse, spd, scd,
  1942. & rpl, ddsddt, drplde, drpldt,
  1943. & EPST0, DEPST, TIME, DTIME,
  1944. & TEMP, DTEMP, PAREX0, DPRED,
  1945. & CMNAME, ndi, nshr, NSIG0, NSTATV,
  1946. & XMATF, NPROPS, COORGA,
  1947. & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  1948. & IB, IGAU, layer, kspt, kstep, KINC )
  1949. C
  1950. ELSE
  1951. C
  1952. C Branchement a la loi externe pointee par m_ptre
  1953. CALL UMATEXT ( m_ptre,
  1954. & SIGF, VARF, ddsdde, sse, spd, scd,
  1955. & rpl, ddsddt, drplde, drpldt,
  1956. & EPST0, DEPST, TIME, DTIME,
  1957. & TEMP, DTEMP, PAREX0, DPRED,
  1958. & CMNAME, ndi, nshr, NSIG0, NSTATV,
  1959. & XMATF, NPROPS, COORGA,
  1960. & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  1961. & IB, IGAU, layer, kspt, kstep, KINC )
  1962. C
  1963. ENDIF
  1964. C
  1965. IF (KINC.NE.1) THEN
  1966. IF (KINC.EQ.0) THEN
  1967. ISIGN = 1
  1968. ELSE
  1969. ISIGN = ABS(KINC)/KINC
  1970. ENDIF
  1971. KERRE = ISIGN*92
  1972. KERR1 = -1-ABS(KINC)
  1973. ENDIF
  1974. C
  1975. C Releve du pas de temps optimal pour l'iteration suivante
  1976. C
  1977. DTOPTI=PNEWDT*DTIME
  1978.  
  1979. RETURN
  1980. C
  1981. C======================================================================
  1982. C MODELE ELASTIQUE NON_LINEAIRE EQUIPLAS
  1983. C======================================================================
  1984. C-----------------------------------------------------------------------
  1985. C Modeles 'VISCO_EXTERNE' : integres par CCREEP
  1986. C-----------------------------------------------------------------------
  1987. 898 CONTINUE
  1988. C
  1989. KERR1 = 0
  1990. C
  1991. C Pointeur (>0) sur fonction externe si definie
  1992. m_ptre = wrk53.jecher
  1993. C
  1994. IF (m_ptre.LE.0) THEN
  1995. C
  1996. C Appel a CCREEP standard de Cast3M
  1997. IFORB = IFOURB
  1998. CALL CCREEP ( wrk52, wrk53, wrk54,
  1999. & IFORB, IB, IGAU, NBPGAU,
  2000. & wcreep, iecou, xecou )
  2001. C
  2002. ELSE
  2003. C
  2004. C Branchement a la loi externe pointee par m_ptre
  2005. C* CALL EXTLOI(m_ptre,...)
  2006. KSTEPC = 251
  2007. C*TMP Option non disponible pour l'instant (cf. modeli.eso)
  2008. C
  2009. ENDIF
  2010.  
  2011. C Erreur detectee par l'integrateur CCREEP
  2012. C
  2013. IF (KERRE.NE.0) THEN
  2014. KERR1 = 1
  2015. RETURN
  2016. ENDIF
  2017. C
  2018. C Erreur lors d'un appel au module utilisateur CREEP
  2019. C
  2020. IF (KSTEPC.NE.1) THEN
  2021. IF (KSTEPC.EQ.0) THEN
  2022. ISIGN = 1
  2023. ELSE
  2024. ISIGN = ABS(KSTEPC)/KSTEPC
  2025. ENDIF
  2026. KERRE = ISIGN*93
  2027. KERR1 = -1-ABS(KSTEPC)
  2028. ENDIF
  2029. RETURN
  2030. C
  2031. C======================================================================
  2032. END
  2033.  
  2034.  

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