Télécharger ecou25.eso

Retour à la liste

Numérotation des lignes :

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

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