Télécharger coml8.eso

Retour à la liste

Numérotation des lignes :

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

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