Télécharger ecou50.eso

Retour à la liste

Numérotation des lignes :

  1. C ECOU50 SOURCE BP208322 17/03/01 21:17:15 9325
  2. SUBROUTINE ECOU50(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: -PLASTIQUE_ENDOM(MAGEABLE)
  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 ENDO0
  143. REAL*8 ENDO(LENDO),RAPP(LENDO)
  144. ENDSEGMENT
  145. *
  146. SEGMENT WRK22
  147. REAL*8 XXE(3,NBNN)
  148. ENDSEGMENT
  149. *
  150. SEGMENT WRK3
  151. REAL*8 WORK(LW),WORK2(LW2)
  152. ENDSEGMENT
  153. *
  154. SEGMENT WRK4
  155. REAL*8 XE(3,NBBB)
  156. ENDSEGMENT
  157. *
  158. SEGMENT WRK5
  159. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  160. ENDSEGMENT
  161. *
  162. SEGMENT WRK6
  163. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  164. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  165. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  166. ENDSEGMENT
  167. *
  168. SEGMENT WRK7
  169. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  170. ENDSEGMENT
  171. *
  172. SEGMENT WRK8
  173. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  174. ENDSEGMENT
  175. *
  176. SEGMENT WRK9
  177. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  178. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  179. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  180. REAL*8 SIGY(NSIGY)
  181. INTEGER NKX(NNKX)
  182. ENDSEGMENT
  183. *
  184. SEGMENT WR10
  185. INTEGER IABLO1(NTABO1)
  186. REAL*8 TABLO2(NTABO2)
  187. ENDSEGMENT
  188. *
  189. SEGMENT WR11
  190. INTEGER IABLO3(NTABO3)
  191. REAL*8 TABLO4(NTABO4)
  192. ENDSEGMENT
  193. *
  194. SEGMENT WTRAV
  195. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  196. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  197. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  198. REAL*8 XLOC(3,3),XGLOB(3,3)
  199. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  200. ENDSEGMENT
  201. *
  202. SEGMENT WPOUT
  203. REAL*8 X(2),Y(2),Z(2)
  204. ENDSEGMENT
  205. *
  206. SEGMENT DRA0
  207. REAL*8 AAA(LDRA0)
  208. ENDSEGMENT
  209. *
  210. * Commun NECOU utilisé dans ECOINC
  211. *
  212. COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  213. . ITYP,IFOURB,IFLUAG,
  214. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  215. . JFLUAG,KFLUAG,LFLUAG,
  216. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  217. *
  218. * Commun IECOU: sert de fourre-tout pour les initialisations
  219. * d'entiers
  220. *
  221. COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  222. . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,
  223. . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,
  224. . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA,
  225. . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA,
  226. . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME,
  227. . icou45,icou46,icou47,icou48,icou49,icou50,
  228. . icou51,icou52,icou53,icou54,icou55,icou56
  229. . icou57,icou58
  230. *
  231. * Commun XECOU: sert de fourre-tout pour les initialisations
  232. * de réels
  233. *
  234. COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP0
  235. *
  236. LOGICAL LOGVIS,LOGIN,LOGRE,LOGSUC
  237. LOGICAL LUNI1,LUNI2
  238. DIMENSION BID(6),BID2(6),CRIGI(12),CMASS(12)
  239. *
  240. CHARACTER*72 CHARRE
  241. CHARACTER*8 CMATE
  242. c
  243. *
  244. * mise à disposition des temperatures tini tfin tref
  245. * aux points de gauss
  246. *
  247. TETA1=-1.E35
  248. TETA2=-1.E35
  249. TETREF=-1.E35
  250. TREFA=-1.E35
  251. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  252. MCHAM3=IPH1
  253. MCHAM4=IPH2
  254. MCHAM5=IPH3
  255. SEGACT MCHAM3
  256. SEGACT MCHAM4
  257. SEGACT MCHAM5
  258. MELVA3=MCHAM3.IELVAL(1)
  259. MELVA4=MCHAM4.IELVAL(1)
  260. MELVA5=MCHAM5.IELVAL(1)
  261. SEGACT MELVA3
  262. SEGACT MELVA4
  263. SEGACT MELVA5
  264. ENDIF
  265. c
  266. c
  267. c Initialisations de variables
  268. c---------------------------------
  269. c - mise à zéro des variables du commun NECOU si besoin
  270. c - modèles viscoplastiques:
  271. c . on récupère le pas de temps
  272. c . on récupère le nombre maximal de sous-pas
  273. c . on met IND=1
  274. c - initialisation des dimensions des tableaux des segments
  275. c Sorties: en plus du commun NECOU, on range les autres données
  276. c initialisées dans les COMMON IECOU et XECOU
  277. c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  278. c argument de DEFINI
  279. c
  280. CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  281. . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  282. . IPMAIL,IVAMAT,
  283. . ITHHER,NUMAT,NUCAR,LOGVIS,
  284. . LUNI1,LUNI2,LW,KERRE)
  285. IF (KERRE.EQ.999) RETURN
  286. c
  287. c Initialisations des segments de travail
  288. c
  289. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  290. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  291. 1 .OR.MFR.EQ.33)) THEN
  292. CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  293. MINTE2=IPTR1
  294. SEGACT MINTE2
  295. SEGINI WRK22
  296. ENDIF
  297. c
  298. IF (LOGVIS) SEGINI WRK8
  299. *
  300. SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  301. IF (INPLAS.EQ.51) SEGINI ENDO0
  302. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1)THEN
  303. SEGINI WRK4
  304. ENDIF
  305. c
  306. SEGINI WTRAV
  307. IF (INPLAS.EQ.75) THEN
  308. LDRA0=951
  309. SEGINI DRA0
  310. ENDIF
  311. *
  312. *
  313. * boucle sur les elements
  314. *
  315. DO 1000 IB=1,NBELEM
  316. *
  317. * Matériaux orthotropes, anisotropes et unidirectionnels
  318. * en formulation massive:
  319. * - on cherche les coordonnees des noeuds de l element ib
  320. * - calcul des axes locaux
  321. * Cas particulier de l'ACIER_UNI
  322. *
  323. CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  324. . MELEME,WRK4,WRK22,WTRAV)
  325. *
  326. *
  327. * boucle sur les points de gauss
  328. *
  329. DO 1100 IGAU=1,NBPTEL
  330. *
  331. * -recuperation de valmat et de valcar
  332. * -on recupere les contraintes initiales
  333. * -on recupere les variables internes
  334. * -on recupere les deformations inelastiques initiales si besoin
  335. * -on recupere les increments de deformations totales
  336. * -on cherche la section de l'element ib
  337. * -prise en compte de l'epaisseur et de l'excentrement
  338. * dans le cas des coques minces avec ou sans cisaillement
  339. * transverse
  340. *
  341. CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  342. . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  343. . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  344. . WTRAV,WRK1,WRK5,SECT,EPAIST)
  345. *
  346. * on recupere les constantes du materiau
  347. * calcul des contraintes effectives en milieu poreux
  348. *
  349. CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  350. . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  351. . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  352. . BID,BID2,KERR0)
  353. IF (KERR0.EQ.99) THEN
  354. KERRE=99
  355. GOTO 1000
  356. ELSE IF (KERR0.EQ.10) THEN
  357. GOTO 1000
  358. ENDIF
  359. *
  360. * >>>>>>>>>> fin du traitement du materiau
  361. *
  362. * on recupere les caracteristiques geometriques
  363. *
  364. CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  365. . WRK1)
  366. *
  367. *
  368. * quelques impressions si iimpi = 99
  369. *
  370. * IF(IIMPI.EQ.99) THEN
  371. * WRITE(IOIMP,66770) IB,IGAU
  372. *66770 format(////////2x,'element ',i6,2x,'point ',i3//)
  373. * WRITE(IOIMP,66771) MATE,INPLAS
  374. *66771 format('0 mate=',i4,2x,'inplas=',i4/)
  375. * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  376. *66772 format(2x,' sig0 '/(6(1x,1pe12.5)))
  377. * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  378. *66773 format(2x,' var0 '/(6(1x,1pe12.5)))
  379. * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  380. *66774 format(2x,' depst '/(6(1x,1pe12.5)))
  381. * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  382. *66775 format(2x,' xmat '/(6(1x,1pe12.5)))
  383. * IF(IVACAR.NE.0)THEN
  384. * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  385. *66776 format(2x,' xcar '/(6(1x,1pe12.5)))
  386. * ENDIF
  387. * ENDIF
  388. *
  389. * mise à disposition des temperatures tini tfin tref
  390. * aux points de gauss
  391. *
  392. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  393. IBMN=MIN(IB,MELVA3.VELCHE(/2))
  394. IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  395. TETA1=MELVA3.VELCHE(IGMN,IBMN)
  396. IBMN=MIN(IB,MELVA4.VELCHE(/2))
  397. IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  398. TETA2=MELVA4.VELCHE(IGMN,IBMN)
  399. IBMN=MIN(IB,MELVA5.VELCHE(/2))
  400. IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  401. TETREF=MELVA5.VELCHE(IGMN,IBMN)
  402. ENDIF
  403. *
  404. *
  405. *---------------------------------------------------------------------
  406. *
  407. * ecoulement selon les modeles
  408. *
  409. *---------------------------------------------------------------------
  410. *
  411. c
  412. c
  413. c modeles implantes dans ecoinc
  414. c
  415. IF (INPLAS.EQ.51) THEN
  416. c
  417. c cas de la plasticite isotrope ecrouissable avec un
  418. c endommagement de type P/Y
  419. c
  420. c on recupere la courbe de traction et la courbe de début d'endommagement
  421. c
  422. CALL COEND(WRK0,WRK2,ENDO0,NCOURB,NENDO,
  423. 1 NRAPP,KERRE)
  424. INPLS0 = 5
  425. IF (VAR0(7).GE.1.D-10) THEN
  426. DO 110 I=1,NSTRS
  427. SIG0(I)=SIG0(I)/VAR0(7)
  428. 110 CONTINUE
  429. ENDIF
  430. c
  431. c calcul des contraintes plastiquement admissibles
  432. c
  433. IF (KERRE .EQ. 0) THEN
  434. DO 1114 IC=1,ICARA
  435. WORK(IC)=XCAR(IC)
  436. 1114 continue
  437. BID(1)=0.D00
  438. BID(2)=0.D00
  439. BID(3)=0.D00
  440. CALL ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  441. 1 N2PTEL,VAR0,BID,BID,XMAT,PRECIS,WORK2,WORK,TRAC,
  442. 2 SIGF,VARF,DEFP,KERRE,MFR1,IB,IGAU,NSTRSS,EPAIST,MELE,
  443. 3 NPINT,NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
  444. 4 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,INPLS0)
  445. END IF
  446. c
  447. c retour au modèle d'endommagement P/Y
  448. c
  449. c calcul des contraintes endommagées
  450. c
  451. CALL PSURY(ENDO,NENDO,NVARI,NSTRSS,MFR1,DEPST,XMAT,VAR0,
  452. 1 RAPP,NRAPP,
  453. 1 SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  454. c
  455. c
  456. ELSE IF (INPLAS.EQ.62) THEN
  457. c
  458. c Modèle d'endommagement de Rousselier
  459. c - on recupère la courbe de traction
  460. c
  461. CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  462. c
  463. c - appel au modèle
  464. C
  465. IF(KERRE.EQ.0) THEN
  466. inecou=0
  467. CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,
  468. 1 DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  469. 2 SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  470. IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  471. KERR1=1
  472. ENDIF
  473. ENDIF
  474. c
  475. c
  476. ELSE IF (INPLAS.EQ.64) THEN
  477. c
  478. c Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  479. c - on recupère la courbe de traction
  480. c
  481. CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  482. c
  483. c - appel au modèle
  484. c
  485. IF(KERRE.EQ.0) THEN
  486. inecou=0
  487. CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,
  488. 1 DSIGT,NCOMAT,SIG0,VAR0,XMAT,XCAR,NVARI,ICARA,
  489. 2 SIGF,VARF,DEFP,TRAC,KERRE,inecou)
  490. IF((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  491. KERR1=1
  492. END IF
  493. ENDIF
  494. c
  495. c
  496. ELSE IF (INPLAS.EQ.75) THEN
  497. c
  498. c Modèle d'endommagement de Dragon
  499. c
  500. CALL DRAGON(WRK0,WRK1,WRK5,DRA0,KERRE)
  501. c
  502. c
  503. ELSE
  504. KERRE = 99
  505. ENDIF
  506. *
  507. * Erreurs
  508. * - problèmes de convergence
  509. *
  510. CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  511. *
  512. * - autres problèmes
  513. *
  514. 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  515. . KERR1,KERRE)
  516. 1998 IF (KERRE.NE.0) THEN
  517. IF (LOGVIS) SEGSUP WRK8
  518. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  519. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  520. SEGSUP WRK4
  521. ENDIF
  522. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  523. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  524. 1 .OR.MFR.EQ.33)) THEN
  525. SEGDES MINTE2
  526. SEGSUP WRK22
  527. ENDIF
  528. IF (INPLAS.EQ.51) SEGSUP ENDO0
  529. IF (INPLAS.EQ.75) SEGSUP DRA0
  530. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  531. SEGDES MELVA3
  532. SEGDES MELVA4
  533. SEGDES MELVA5
  534. SEGDES MCHAM3
  535. SEGDES MCHAM4
  536. SEGDES MCHAM5
  537. ENDIF
  538. RETURN
  539. ENDIF
  540. *
  541. c
  542. c remplissage du segment contenant les contraintes a la fin
  543. * ( rearrangement pour milieu poreux ),
  544. c les variables internes finales
  545. c et les increments de deformations plastiques
  546. c
  547. CALL DEFSIG(MFR,NDEF,
  548. . INPLAS,IND,WRK1,WRK5,WTRAV,
  549. . IVASTF,IVARIF,IVADEP,COB,XMOB,IB,IGAU,
  550. . CMATE,MATE,MELE,KERRER)
  551. IF (KERRER.NE.0) GOTO 1000
  552. c
  553. c
  554. c fin de la boucle sur les points de gauss
  555. c
  556. 1100 continue
  557. c
  558. c special poutres et tuyaux sauf timoschenko
  559. c
  560. CALL DEFPOU(MFR,MELE,MELEME,IB,WRK4,IVASTF)
  561. c
  562. c fin de la boucle sur les elements
  563. c
  564. 1000 continue
  565. c
  566. * FIN: modèles visqueux, on stocke le pas de temps
  567. * optimal en indice 'dtopti'
  568. *
  569. CALL DEFFIN(INPLAS,TSOM,NSOM,NCOMP,NINV,NINCMA,
  570. . TCAR,DTOPTI,IPOTAB,KERRE)
  571. IF (LOGVIS) SEGSUP WRK8
  572. *
  573. *
  574. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  575. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1) THEN
  576. SEGSUP WRK4
  577. END IF
  578. IF (INPLAS.EQ.51) SEGSUP ENDO0
  579. IF (INPLAS.EQ.75) SEGSUP DRA0
  580. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  581. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  582. 1 .OR.MFR.EQ.33)) THEN
  583. SEGDES MINTE2
  584. SEGSUP WRK22
  585. ENDIF
  586. *
  587. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  588. SEGDES MELVA3
  589. SEGDES MELVA4
  590. SEGDES MELVA5
  591. SEGDES MCHAM3
  592. SEGDES MCHAM4
  593. SEGDES MCHAM5
  594. ENDIF
  595. *
  596. RETURN
  597. END
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633.  
  634.  
  635.  
  636.  

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