Télécharger ecou21.eso

Retour à la liste

Numérotation des lignes :

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

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