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

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