Télécharger ecou29.eso

Retour à la liste

Numérotation des lignes :

  1. C ECOU29 SOURCE BP208322 17/03/01 21:17:12 9325
  2. SUBROUTINE ECOU29(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR,
  3. 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET,
  4. 1 IVADS,IVAMAT,IVACAR,
  5. 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVARI,NMATT,NCARR,
  6. 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC,
  7. 4 N2EL,N2PTEL,NBNO,NBPGAU,LW,IVASTF,IVARIF,IVADEP,KERRE)
  8. ***********************************************************************
  9. * ecoulement inelastique appele par ecoul1
  10. c ppu modif pour les materiaux unidirectionels en plastique
  11. * MATERIAUX ENDOMMAGEABLES DE LEMAITRE
  12. ***********************************************************************
  13. * entrees :
  14. *
  15. * mate = numero de materiau elastique
  16. * inplas = numero de materiau inelastique
  17. * mele = numero element fini
  18. * ipmail = pointeur du maillage
  19. * nbptel = nombre de points par element
  20. * imat = pointeur sur un segment mptval de materiau (utilise par calsig)
  21. * icar = pointeur sur un segment mptval de caracteristiques
  22. * geometriques (utilise par calsig)
  23. * numat = nb de composantes du melval de imat
  24. * nucar = nb de composantes du melval de icar
  25. * ivastr =pointeur sur un segment mptval de contraintes
  26. * ivari =pointeur sur un segment mptval de variables internes
  27. * ivadef =pointeur sur un segment mptval de deformations
  28. * ivads =pointeur sur un segment mptval de contraintes (increments)
  29. * ivamat =pointeur sur un segment mptval de materiau
  30. * ivacar =pointeur sur un segment mptval de cacarteristiques geometrique
  31. * iph1 = pointeur sur un mchaml de temperatures au debut du pas
  32. * iph2 = pointeur sur un mchaml de temperatures a la fin du pas
  33. * iph3 = pointeur sur un mchaml de temperatures de reference
  34. * ithher = 0 si pas de chargement thermique
  35. * = 1 si chargement thermique mais materiau constant
  36. * = 2 si chargement thermique et mat. dependant de la temperature
  37. * ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux
  38. * endommageables de lemaitre quand ils dependent de la temperature
  39. * lhook =taille de la matrice de hooke
  40. * nstrs =nombre de composantes de contraintes
  41. * nvari =nombre de composantes de variables internes
  42. * nmatt =nombre de composnates de proprietes de materiau
  43. * ncarr =nombre de composnates de caracteristiques geometriques
  44. * cmate =nom du materiau
  45. * precis =precision dans les iterations internes
  46. * jecher =0 ou 1 pour action dans ecoule
  47. * jnoid =0 ou 1 pour action dans ecoule
  48. * ipotab =pointeur sur segment table
  49. * istep =indicateur d'action pour calcul nonlocal
  50. * =0 dans le cas d'un calcul local (normal)
  51. * =1 ou 2 dans le cas d'un calcul nonlocal
  52. * =1 pour calcul des fonctions seuil uniquement
  53. * =2 pour calcul des variables dissipatives a partir
  54. * des fonctions seuil moyennees prealablement par nloc
  55. *
  56. * sorties :
  57. * ivastf =pointeur sur un segment mptval de contraintes
  58. * ivarif =pointeur sur un segment mptval de variables internes
  59. * ivadep =pointeur sur un segment mptval de deformations inelastiques
  60. * kerre =indicateur d'erreur
  61. *
  62. * p dowlatyari fev. 1992
  63. *
  64. * c. la borderie fev 92 restructuration et reecriture de certains
  65. * passages pour une meilleure lisibilite
  66. *
  67. * avril 92 ajout istep pour le non local
  68. * dec 92 modif pour poutres timoschenko
  69. *
  70. ************************************************************************
  71. IMPLICIT INTEGER(I-N)
  72. IMPLICIT REAL*8(A-H,O-Z)
  73. *
  74. -INC CCOPTIO
  75. -INC SMCHAML
  76. -INC SMELEME
  77. -INC SMCOORD
  78. -INC SMMODEL
  79. -INC SMINTE
  80. -INC CCHAMP
  81. c=======================================================================
  82. c la variable kerre regit les impressions d erreurs dans plast
  83. c toutes erreurs de ecoule gerees dans ce sous programme
  84. c kerre=0 tout ok
  85. c de 1 a 6 s aligner sur valeurs donnees par ecoinc
  86. c = 7 un element tuyau a une epaisseur nulle
  87. c = 21 on ne trouve pas d intersection avec la surface de charge
  88. c = 22 sig0 a l exterieur de la surface de charge
  89. c
  90. c anomalies avec la courbe de traction
  91. c = 30 limite elastique nulle
  92. c = 31 trop de points
  93. c = 32 pas assez de points
  94. c = 33 pente incorrecte
  95. c = 34 module d'young nul
  96. c = 35 manque l'origine
  97. c = 36 pente a l'origine non egale a e
  98. c = 37 manque la courbe de traction
  99. c = 38 nu devrait etre nul
  100. c
  101. c = 48 donnees erronnees pour drucker-prager
  102. c = 49 matrice singuliere dans iter internes drucker-prager
  103. c = 51 pb dans drucker prager option non disponible
  104. c = 52 pb dans drucker prager donnees incompatibles
  105. c = 53 pb dans drucker prager solution impossible
  106. c = 54 les valeurs admissibles pour istep sont 0 1 ou 2
  107. c = 55 modele non implante en non local
  108. c = 56 probleme dans l'integration du modele mazars
  109. c = 57 ....
  110. c = 58 ....
  111. c = 59 ....
  112. c = 60 pb donnees du cam-clay
  113. c
  114. c = 99 cas non encore disponible
  115. c=======================================================================
  116. *
  117. SEGMENT MPTVAL
  118. INTEGER IPOS(NS) ,NSOF(NS)
  119. INTEGER IVAL(NCOSOU)
  120. CHARACTER*16 TYVAL(NCOSOU)
  121. ENDSEGMENT
  122. *
  123. SEGMENT WRK0
  124. REAL*8 XMAT(NCXMAT)
  125. ENDSEGMENT
  126. *
  127. SEGMENT WR00
  128. CHARACTER*16 TYMAT(NCXMAT)
  129. REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  130. ENDSEGMENT
  131. *
  132. SEGMENT WRK1
  133. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  134. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  135. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  136. ENDSEGMENT
  137. *
  138. SEGMENT WRK2
  139. REAL*8 TRAC(LTRAC)
  140. ENDSEGMENT
  141. *
  142. SEGMENT WRK22
  143. REAL*8 XXE(3,NBNN)
  144. ENDSEGMENT
  145. *
  146. SEGMENT WRK3
  147. REAL*8 WORK(LW),WORK2(LW2)
  148. ENDSEGMENT
  149. *
  150. SEGMENT WRK4
  151. REAL*8 XE(3,NBBB)
  152. ENDSEGMENT
  153. *
  154. SEGMENT WRK5
  155. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  156. ENDSEGMENT
  157. *
  158. SEGMENT WRK6
  159. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  160. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  161. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS)
  162. ENDSEGMENT
  163. *
  164. SEGMENT WRK7
  165. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  166. ENDSEGMENT
  167. *
  168. SEGMENT WRK8
  169. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  170. ENDSEGMENT
  171. *
  172. SEGMENT WRK9
  173. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  174. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  175. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  176. REAL*8 SIGY(NSIGY)
  177. INTEGER NKX(NNKX)
  178. ENDSEGMENT
  179. *
  180. SEGMENT WR10
  181. INTEGER IABLO1(NTABO1)
  182. REAL*8 TABLO2(NTABO2)
  183. ENDSEGMENT
  184. *
  185. SEGMENT WR11
  186. INTEGER IABLO3(NTABO3)
  187. REAL*8 TABLO4(NTABO4)
  188. ENDSEGMENT
  189. *
  190. SEGMENT WTRAV
  191. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  192. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  193. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  194. REAL*8 XLOC(3,3),XGLOB(3,3)
  195. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  196. ENDSEGMENT
  197. *
  198. SEGMENT WPOUT
  199. REAL*8 X(2),Y(2),Z(2)
  200. ENDSEGMENT
  201. *
  202. * Commun NECOU utilisé dans ECOINC
  203. *
  204. COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  205. . ITYP,IFOURB,IFLUAG,
  206. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  207. . JFLUAG,KFLUAG,LFLUAG,
  208. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  209. *
  210. * Commun IECOU: sert de fourre-tout pour les initialisations
  211. * d'entiers
  212. *
  213. COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  214. . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,
  215. . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,
  216. . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA,
  217. . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA,
  218. . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME,
  219. . icou45,icou46,icou47,icou48,icou49,icou50,
  220. . icou51,icou52,icou53,icou54,icou55,icou56
  221. . icou57,icou58
  222. *
  223. * Commun XECOU: sert de fourre-tout pour les initialisations
  224. * de réels
  225. *
  226. COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP0
  227. *
  228. LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  229. LOGICAL LUNI1,LUNI2
  230. DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  231. *
  232. CHARACTER*72 CHARRE
  233. CHARACTER*8 CMATE
  234. *
  235. *
  236. * mise à disposition des temperatures tini tfin tref
  237. * aux points de gauss
  238. *
  239. TETA1=-1.E35
  240. TETA2=-1.E35
  241. TETREF=-1.E35
  242. TREFA=-1.E35
  243. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  244. MCHAM3=IPH1
  245. MCHAM4=IPH2
  246. MCHAM5=IPH3
  247. SEGACT MCHAM3
  248. SEGACT MCHAM4
  249. SEGACT MCHAM5
  250. MELVA3=MCHAM3.IELVAL(1)
  251. MELVA4=MCHAM4.IELVAL(1)
  252. MELVA5=MCHAM5.IELVAL(1)
  253. SEGACT MELVA3
  254. SEGACT MELVA4
  255. SEGACT MELVA5
  256. ENDIF
  257. c
  258. c Initialisations de variables
  259. c---------------------------------
  260. c - mise à zéro des variables du commun NECOU si besoin
  261. c - modèles viscoplastiques:
  262. c . on récupère le pas de temps
  263. c . on récupère le nombre maximal de sous-pas
  264. c . on met IND=1
  265. c - initialisation des dimensions des tableaux des segments
  266. c Sorties: en plus du commun NECOU, on range les autres données
  267. c initialisées dans les COMMON IECOU et XECOU
  268. c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  269. c argument de DEFINI
  270. c
  271. CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  272. . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  273. . IPMAIL,IVAMAT,
  274. . ITHHER,NUMAT,NUCAR,LOGVIS,
  275. . LUNI1,LUNI2,LW,KERRE)
  276. IF (KERRE.EQ.999) RETURN
  277. c
  278. c Initialisations des segments de travail
  279. c
  280. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  281. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  282. 1 .OR.MFR.EQ.33)) THEN
  283. CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  284. MINTE2=IPTR1
  285. SEGACT MINTE2
  286. SEGINI WRK22
  287. ENDIF
  288. c
  289. IF (LOGVIS) SEGINI WRK8
  290. *
  291. * initialisation des segments de travail
  292. *
  293. SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  294. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  295. SEGINI WRK4
  296. ENDIF
  297. IF(INPLAS.EQ.26)THEN
  298. SEGINI WRK6
  299. ENDIF
  300. c
  301. SEGINI WTRAV
  302. *
  303. *
  304. * boucle sur les elements
  305. *
  306. DO 1000 IB=1,NBELEM
  307. *
  308. * Matériaux orthotropes, anisotropes et unidirectionnels
  309. * en formulation massive:
  310. * - on cherche les coordonnees des noeuds de l element ib
  311. * - calcul des axes locaux
  312. * Cas particulier de l'ACIER_UNI
  313. *
  314. CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  315. . MELEME,WRK4,WRK22,WTRAV)
  316. *
  317. *
  318. * boucle sur les points de gauss
  319. *
  320. DO 1100 IGAU=1,NBPTEL
  321.  
  322. *
  323. * -recuperation de valmat et de valcar
  324. * -on recupere les contraintes initiales
  325. * -on recupere les variables internes
  326. * -on recupere les deformations inelastiques initiales si besoin
  327. * -on recupere les increments de deformations totales
  328. * -on cherche la section de l'element ib
  329. * -prise en compte de l'epaisseur et de l'excentrement
  330. * dans le cas des coques minces avec ou sans cisaillement
  331. * transverse
  332. *
  333. CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  334. . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  335. . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  336. . WTRAV,WRK1,WRK5,SECT,EPAIST)
  337. *
  338. * on recupere les constantes du materiau
  339. * calcul des contraintes effectives en milieu poreux
  340. *
  341. CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  342. . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  343. . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  344. . BID,BID2,KERR0)
  345. IF (KERR0.EQ.99) THEN
  346. KERRE=99
  347. GOTO 1000
  348. ELSE IF (KERR0.EQ.10) THEN
  349. GOTO 1000
  350. ENDIF
  351. *
  352. IF ((INPLAS.EQ.29.).OR.(INPLAS.EQ.26)) THEN
  353. *
  354. * pour les materiaux endommageables de lemaitre traitement special
  355. * car ils peuvent dependre de la temperature
  356. *
  357. NTABO1 = 0
  358. NTABO2 = 0
  359. SEGINI WR10
  360. DO 2200 JC=1,NMATT
  361. IF (TYMAT(JC)(1:8).EQ.'REAL*8 ') THEN
  362. NTABO1=NTABO1+1
  363. NTABO2=NTABO2+1
  364. SEGADJ WR10
  365. IABLO1(NTABO1)=1
  366. TABLO2(NTABO2)=XMAT(JC)
  367. ELSE IF (TYMAT(JC)(9:16).EQ.'EVOLUTIO') THEN
  368. CALL KSISIG(WRK0,JC,WRK2,NCOURB,KERRE)
  369. IF (KERRE.NE.0) GOTO 1990
  370. NTABO1=NTABO1+1
  371. NTABO=NTABO2
  372. NTABO2=NTABO2+(2*NCOURB)
  373. SEGADJ WR10
  374. IABLO1(NTABO1)=2*NCOURB
  375. DO 2050 JCC=1,NCOURB
  376. TABLO2(NTABO+(2*JCC-1))=TRAC(2*JCC-1)
  377. TABLO2(NTABO+(2*JCC))=TRAC(2*JCC)
  378. 2050 continue
  379. ELSE IF (TYMAT(JC)(9:16).EQ.'NUAGE ') THEN
  380. NTABO3 = 0
  381. NTABO4 = 0
  382. SEGINI WR11
  383. CALL XNUAGE(WRK0,JC,WR11,NTABO3,NTABO4,KERRE)
  384. IF (KERRE.NE.0) THEN
  385. SEGSUP WR10
  386. SEGSUP WR11
  387. KERR1=2
  388. GOTO 1990
  389. ENDIF
  390. * segadj wr11
  391. NTABO=NTABO1
  392. NTABOO=NTABO2
  393. NTABO1=NTABO1+NTABO3+1
  394. NTABO2=NTABO2+NTABO4
  395. SEGADJ WR10
  396. IABLO1(NTABO+1)=NTABO3
  397. DO 2075 JCC=1,NTABO3
  398. 2075 iablo1(ntabo+1+jcc)=iablo3(jcc)
  399. DO 2125 JCC=1,NTABO4
  400. 2125 tablo2(ntaboo+jcc)=tablo4(jcc)
  401. SEGSUP WR11
  402. ENDIF
  403. 2200 continue
  404. ENDIF
  405. *
  406. * >>>>>>>>>> fin du traitement du materiau
  407. *
  408. * on recupere les caracteristiques geometriques
  409. *
  410. CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  411. . WRK1)
  412. * CALL DEFCAR(NCARR,ICARA,IB,IGAU,MFR,MELE,IVACAR,
  413. * . XCAR)
  414. *
  415. *
  416. * quelques impressions si iimpi = 99
  417. *
  418. * IF(IIMPI.EQ.99) THEN
  419. * WRITE(IOIMP,66770) IB,IGAU
  420. *66770 format(////////2x,'element ',i6,2x,'point ',i3//)
  421. * WRITE(IOIMP,66771) MATE,INPLAS
  422. *66771 format('0 mate=',i4,2x,'inplas=',i4/)
  423. * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  424. *66772 format(2x,' sig0 '/(6(1x,1pe12.5)))
  425. * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  426. *66773 format(2x,' var0 '/(6(1x,1pe12.5)))
  427. * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  428. *66774 format(2x,' depst '/(6(1x,1pe12.5)))
  429. * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  430. *66775 format(2x,' xmat '/(6(1x,1pe12.5)))
  431. * IF(IVACAR.NE.0)THEN
  432. * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  433. *66776 format(2x,' xcar '/(6(1x,1pe12.5)))
  434. * ENDIF
  435. * ENDIF
  436. *
  437. * mise à disposition des temperatures tini tfin tref
  438. * aux points de gauss
  439. *
  440. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  441. IBMN=MIN(IB,MELVA3.VELCHE(/2))
  442. IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  443. TETA1=MELVA3.VELCHE(IGMN,IBMN)
  444. IBMN=MIN(IB,MELVA4.VELCHE(/2))
  445. IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  446. TETA2=MELVA4.VELCHE(IGMN,IBMN)
  447. IBMN=MIN(IB,MELVA5.VELCHE(/2))
  448. IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  449. TETREF=MELVA5.VELCHE(IGMN,IBMN)
  450. ENDIF
  451. *
  452. *
  453. *---------------------------------------------------------------------
  454. *
  455. * ecoulement selon les modeles
  456. *
  457. *---------------------------------------------------------------------
  458. *
  459. *
  460. * modeles de viscoplasticite integres par consti
  461. *
  462. IF ( INPLAS .EQ. 29) THEN
  463. *
  464. NYOG=IABLO1(1)
  465. NYNU=IABLO1(2)
  466. NYALFA=IABLO1(3)
  467. NYSMAX=IABLO1(4)
  468. NYN=IABLO1(5)
  469. NYM=IABLO1(6)
  470. NYKK=IABLO1(7)
  471. NYALF1=IABLO1(8)
  472. NYBET1=IABLO1(9)
  473. NYR=IABLO1(10)
  474. NYA=IABLO1(11)
  475. IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  476. + AND.IFOUR.EQ.-2) THEN
  477. INTMAT=15
  478. ELSE
  479. INTMAT=14
  480. ENDIF
  481. IF (NTABO1.EQ.INTMAT) THEN
  482. NNKX=1
  483. NYKX=IABLO1(12)
  484. ELSE
  485. NNKX=IABLO1(12)
  486. NYKX=0
  487. DO 1881 I=1,NNKX
  488. 1881 NYKX=NYKX+(2*IABLO1(12+I))
  489. NYKX=NYKX+NNKX
  490. ENDIF
  491. NYRHO=IABLO1(NTABO1)
  492. NSIGY=1
  493. SEGINI WRK9
  494. CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  495. SEGSUP WR10
  496. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  497. NCOURB=2*NKX(1)
  498. ELSE
  499. NCOURB=NKX(1)
  500. DO 1882 I=1,NNKX
  501. 1882 IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  502. NCOURB=2*NCOURB
  503. ENDIF
  504. SEGINI WRK7
  505. IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN
  506. CALL ZDANUL(SIGF,NSTRS)
  507. DO 1883 I=1,NVARI
  508. VARF(I) = VAR0(I)
  509. 1883 CONTINUE
  510. VARF(3) = 1.0
  511. DO 1884 I=1,NSTRS
  512. EPINF(I) = EPIN0(I)
  513. 1884 CONTINUE
  514. SEGSUP WRK7
  515. SEGSUP WRK9
  516. ELSE
  517. CALL CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  518. 1 INPLAS,MFR1,DT,NSTRSS,NVARI,NMATT,PRECIS,MSOUPA,JECHER,DTT,
  519. 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,NYN,
  520. 3 NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,TETA1,
  521. 5 TETA2,TREFA,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,
  522. 6 EPAIST,NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  523. c
  524. c
  525. SEGSUP WRK7
  526. SEGSUP WRK9
  527. IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN
  528. INTERR(1)=IB
  529. INTERR(2)=IGAU
  530. REAERR(1)=TLIFE
  531. CALL ERREUR(-279)
  532. ENDIF
  533. DTOPTI = MIN(DTOPTI,DTT)
  534. NINCMA = MAX(NINCMA,NSSINC)
  535. NCOMP = NCOMP + 1
  536. TSOM = TSOM + DTT
  537. NSOM = NSOM + NSSINC
  538. NINV = NINV + INV
  539. TCAR = TCAR + DTT* DTT
  540. IF(KERRE.NE.0) THEN
  541. KERR1=1
  542. END IF
  543. END IF
  544. c
  545. c modele plastique d'endommagement de lemaitre
  546. c ++++++++++++++++++++++++++++++++++++++++++++
  547. c traitement du materiau qui depend eventuellement de la temperature
  548. c ------------------------------------------------------------------
  549. ELSE IF (INPLAS.EQ.26) THEN
  550. NYOG=IABLO1(1)
  551. NYNU=IABLO1(2)
  552. NYRHO=IABLO1(3)
  553. NYALFA=IABLO1(4)
  554. IF ((MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33).
  555. + AND.IFOUR.EQ.-2) THEN
  556. INTMAT=10
  557. ELSE
  558. INTMAT=9
  559. ENDIF
  560. IF (NTABO1.EQ.INTMAT) THEN
  561. NNKX=1
  562. NYKX=IABLO1(5)
  563. IEPS=0
  564. ELSE
  565. NNKX=IABLO1(5)
  566. NYKX=0
  567. DO 1789 I=1,NNKX
  568. 1789 NYKX=NYKX+(2*IABLO1(5+I))
  569. NYKX=NYKX+NNKX
  570. IEPS=1
  571. ENDIF
  572. IORIGI=6+(IEPS*NNKX)
  573. NYN=IABLO1(IORIGI)
  574. NYM=IABLO1(IORIGI+1)
  575. NYKK=IABLO1(IORIGI+2)
  576. NYSMAX=0
  577. NYALF1=0
  578. NYBET1=0
  579. NYR=0
  580. NYA=0
  581. NSIGY=0
  582. SEGINI WRK9
  583. CALL MAT29(WR10,WRK9,INPLAS,IFOUR,MFR)
  584. SEGSUP WR10
  585. c
  586. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  587. c *** on n' ecoule pas
  588. c
  589. CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  590. IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  591. DO 1115 IEN=1,NVARI
  592. VARF(IEN)=VAR0(IEN)
  593. 1115 continue
  594. VARF(3)=1.D0
  595. CALL ZDANUL(SIGF,NSTRS)
  596. CALL ZDANUL(DEFP,NSTRS)
  597. SEGSUP WRK9
  598. ELSE
  599. c ----------------------------------------------------------------------
  600. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  601. c p est en supplement
  602. c ----------------------------------------------------------------------
  603. NNVARI=2
  604. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  605. CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  606. NCOURB=2*NKX(1)
  607. ELSE
  608. NCOURB=NKX(1)
  609. DO 1119 I=1,NNKX
  610. 1119 if (nkx(i).ge.ncourb) ncourb=nkx(i)
  611. NCOURB=4*NCOURB
  612. ENDIF
  613. IF (KERRE.EQ.0) THEN
  614. SEGINI WRK7
  615. CALL ENDOM(WRK0,WR00,WRK1,WRK6,WRK7,WRK8,WRK9,WTRAV,NSTRSS,
  616. 1 NMATT,ICARA,INPLAS,NVARI,PRECIS,MFR1,IFOURB,KERRE,NNVARI,
  617. 2 NYOG,NYNU,NYRHO,NYALFA,NNKX,NYKX,NCOURB,NYN,NYM,NYKK,TETA1,
  618. 3 TETA2,TREFA,ITHHER,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  619. 4 MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI)
  620. SEGSUP WRK7
  621. SEGSUP WRK9
  622. IF(KERRE.GT.200) THEN
  623. KERR1=1
  624. END IF
  625. END IF
  626. END IF
  627. ELSE
  628. KERRE = 99
  629. ENDIF
  630. *
  631. * Erreurs
  632. * - problèmes de convergence
  633. *
  634. CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  635. *
  636. * - autres problèmes
  637. *
  638. 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  639. . KERR1,KERRE)
  640. 1998 IF (KERRE.GT.0) THEN
  641. IF (LOGVIS) SEGSUP WRK8
  642. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  643. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  644. SEGSUP WRK4
  645. ENDIF
  646. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  647. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  648. 1 .OR.MFR.EQ.33)) THEN
  649. SEGDES MINTE2
  650. SEGSUP WRK22
  651. ENDIF
  652. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  653. SEGDES MELVA3
  654. SEGDES MELVA4
  655. SEGDES MELVA5
  656. SEGDES MCHAM3
  657. SEGDES MCHAM4
  658. SEGDES MCHAM5
  659. ENDIF
  660. RETURN
  661. ENDIF
  662. c
  663. c
  664. c remplissage du segment contenant les contraintes a la fin
  665. * ( rearrangement pour milieu poreux ),
  666. c les variables internes finales
  667. c et les increments de deformations plastiques
  668. c
  669. CALL DEFSIG(MFR,NDEF,
  670. . INPLAS,IND,WRK1,WRK5,WTRAV,
  671. . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  672. . CMATE,MATE,MELE,KERRER)
  673. IF (KERRER.GT.0) GOTO 1000
  674. c
  675. c
  676. c fin de la boucle sur les points de gauss
  677. c
  678. 1100 continue
  679. c
  680. c special poutres et tuyaux sauf timoschenko
  681. c
  682. CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  683. c
  684. c fin de la boucle sur les elements
  685. c
  686. 1000 continue
  687. c
  688. * FIN: modèles visqueux, on stocke le pas de temps
  689. * optimal en indice 'dtopti'
  690. *
  691. CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  692. . TCAR,DTOPTI,IPOTAB,KERRE)
  693. IF (LOGVIS) SEGSUP WRK8
  694. *
  695. *
  696. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  697. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  698. SEGSUP WRK4
  699. END IF
  700. IF(INPLAS.EQ.26) THEN
  701. SEGSUP WRK6
  702. SEGSUP WRK8
  703. END IF
  704. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  705. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  706. 1 .OR.MFR.EQ.33)) THEN
  707. SEGDES MINTE2
  708. SEGSUP WRK22
  709. ENDIF
  710. *
  711. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  712. SEGDES MELVA3
  713. SEGDES MELVA4
  714. SEGDES MELVA5
  715. SEGDES MCHAM3
  716. SEGDES MCHAM4
  717. SEGDES MCHAM5
  718. ENDIF
  719. *
  720. RETURN
  721. END
  722.  
  723.  
  724.  
  725.  
  726.  
  727.  
  728.  
  729.  
  730.  
  731.  
  732.  
  733.  
  734.  
  735.  
  736.  
  737.  
  738.  
  739.  
  740.  
  741.  
  742.  
  743.  
  744.  
  745.  
  746.  
  747.  
  748.  
  749.  

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