Télécharger ecou10.eso

Retour à la liste

Numérotation des lignes :

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

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