Télécharger ecou70.eso

Retour à la liste

Numérotation des lignes :

  1. C ECOU70 SOURCE BP208322 17/03/01 21:17:17 9325
  2. SUBROUTINE ECOU70(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,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. * MATERIAUX: -PLASTIQUES NON INTEGRES PAR ECOINC
  11. * suite de ECOU60
  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 WRK22
  143. REAL*8 XXE(3,NBNN)
  144. ENDSEGMENT
  145. *
  146. SEGMENT WRK3
  147. REAL*8 WORK(LW),WORK2(LW2)
  148. ENDSEGMENT
  149. *
  150. SEGMENT WRK4
  151. REAL*8 XE(3,NBNN)
  152. ENDSEGMENT
  153. *
  154. SEGMENT WRK5
  155. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  156. ENDSEGMENT
  157. *
  158. SEGMENT WRK6
  159. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  160. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  161. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  162. ENDSEGMENT
  163. *
  164. SEGMENT WRK7
  165. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  166. ENDSEGMENT
  167. *
  168. SEGMENT WRK8
  169. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  170. ENDSEGMENT
  171. *
  172. SEGMENT WRK9
  173. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  174. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  175. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  176. REAL*8 SIGY(NSIGY)
  177. INTEGER NKX(NNKX)
  178. ENDSEGMENT
  179. *
  180. SEGMENT WR10
  181. INTEGER IABLO1(NTABO1)
  182. REAL*8 TABLO2(NTABO2)
  183. ENDSEGMENT
  184. *
  185. SEGMENT WR11
  186. INTEGER IABLO3(NTABO3)
  187. REAL*8 TABLO4(NTABO4)
  188. ENDSEGMENT
  189. *
  190. SEGMENT WTRAV
  191. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  192. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  193. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  194. REAL*8 XLOC(3,3),XGLOB(3,3)
  195. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  196. ENDSEGMENT
  197. *
  198. SEGMENT WPOUT
  199. REAL*8 X(2),Y(2),Z(2)
  200. ENDSEGMENT
  201. *
  202. * Commun NECOU utilisé dans ECOINC
  203. *
  204. COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  205. . ITYP,IFOURB,IFLUAG,
  206. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  207. . JFLUAG,KFLUAG,LFLUAG,
  208. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  209. *
  210. * Commun IECOU: sert de fourre-tout pour les initialisations
  211. * d'entiers
  212. *
  213. COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  214. . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,
  215. . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,
  216. . LTRAC,MFR,IELE,NHRM,NBNN,NBELEM,ICARA,
  217. . LW2,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA,
  218. . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME,
  219. . icou45,icou46,icou47,icou48,icou49,icou50,
  220. . icou51,icou52,icou53,icou54,icou55,icou56
  221. . icou57,icou58
  222. *
  223. * Commun XECOU: sert de fourre-tout pour les initialisations
  224. * de réels
  225. *
  226. COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP0
  227. *
  228. REAL*8 LCAR
  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. ****************************
  259. * SPECIAL SUCCION
  260. *
  261. SUCC1=-1.E35
  262. SUCC2=-1.E35
  263. IF (ITHHER.EQ.3) THEN
  264. MCHAM3=IPH1
  265. MCHAM4=IPH2
  266. SEGACT MCHAM3
  267. SEGACT MCHAM4
  268. MELVA3=MCHAM3.IELVAL(1)
  269. MELVA4=MCHAM4.IELVAL(1)
  270. SEGACT MELVA3
  271. SEGACT MELVA4
  272. ENDIF
  273. ****************************
  274. c
  275. c Initialisations de variables
  276. c---------------------------------
  277. c - mise à zéro des variables du commun NECOU si besoin
  278. c - modèles viscoplastiques:
  279. c . on récupère le pas de temps
  280. c . on récupère le nombre maximal de sous-pas
  281. c . on met IND=1
  282. c - initialisation des dimensions des tableaux des segments
  283. c Sorties: en plus du commun NECOU, on range les autres données
  284. c initialisées dans les COMMON IECOU et XECOU
  285. c Sauf pour KERRE,LW,LOGVIS,LUNI1 et LUNI2 qui sont sortis comme
  286. c argument de DEFINI
  287. c
  288. CALL DEFINI(MELE,NCARR,NSTRS,NMATT,CMATE,MATE,
  289. . ISTEP,INPLAS,NPINT,IPOTAB,IVADEF,
  290. . IPMAIL,IVAMAT,
  291. . ITHHER,NUMAT,NUCAR,LOGVIS,
  292. . LUNI1,LUNI2,LW,KERRE)
  293. IF (KERRE.EQ.999) RETURN
  294. c
  295. c Initialisations des segments de travail
  296. c
  297. c
  298. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  299. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  300. 1 .OR.MFR.EQ.33)) THEN
  301. CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPTR1,IRT1)
  302. MINTE2=IPTR1
  303. SEGACT MINTE2
  304. SEGINI WRK22
  305. ENDIF
  306. c
  307. IF (LOGVIS) SEGINI WRK8
  308. SEGINI WRK0,WR00,WRK1,WRK2,WRK3,WRK5
  309. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN
  310. SEGINI WRK4
  311. ENDIF
  312. c
  313. SEGINI WTRAV
  314. *
  315. *
  316. * boucle sur les elements
  317. *
  318. DO 1000 IB=1,NBELEM
  319. *
  320. * Matériaux orthotropes, anisotropes et unidirectionnels
  321. * en formulation massive:
  322. * - on cherche les coordonnees des noeuds de l element ib
  323. * - calcul des axes locaux
  324. * Cas particulier de l'ACIER_UNI
  325. *
  326. CALL DEFROT(CMATE,MFR,NBNN,IB,MELE,LUNI1,IPTR1,
  327. . MELEME,WRK4,WRK22,WTRAV)
  328. *
  329. IF(INPLAS.EQ.66) THEN
  330. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  331. ENDIF
  332. *
  333. * CALCUL DE LA LONGUEUR CARACTERISTIQUE DE L'éLéMENT COURANT
  334. * POUR MODèLE BETON URGC INSA
  335. *
  336.  
  337. IF(INPLAS.GE.99.AND.INPLAS.LE.101) THEN
  338. CALL LONGCA(IPMAIL,IB,LCAR)
  339. ENDIF
  340.  
  341. *
  342. * boucle sur les points de gauss
  343. *
  344. DO 1100 IGAU=1,NBPTEL
  345. *
  346. * -recuperation de valmat et de valcar
  347. * -on recupere les contraintes initiales
  348. * -on recupere les variables internes
  349. * -on recupere les deformations inelastiques initiales si besoin
  350. * -on recupere les increments de deformations totales
  351. * -on cherche la section de l'element ib
  352. * -prise en compte de l'epaisseur et de l'excentrement
  353. * dans le cas des coques minces avec ou sans cisaillement
  354. * transverse
  355. *
  356. CALL DEFVAL(NUMAT1,NBPTEL,NDEF,
  357. . IMAT,IVACAR,ICAR,IVASTR,IVARI,IVADEF,IVADET,
  358. . IVADS,MFR,CMATE,INPLAS,IB,IGAU,IND,
  359. . WTRAV,WRK1,WRK5,SECT,EPAIST)
  360. *
  361. * on recupere les constantes du materiau
  362. * calcul des contraintes effectives en milieu poreux
  363. *
  364. CALL DEFMAT(NMATT,NSTRS,MFR,MELE,INPLAS,
  365. . IVAMAT,IB,IGAU,CMATE,MATE,LUNI1,LUNI2,
  366. . WRK1,WRK5,WRK0,WR00,WTRAV,CMASS,CRIGI,COB,XMOB,
  367. . BID,BID2,KERR0)
  368. IF (KERR0.EQ.99) THEN
  369. KERRE=99
  370. GOTO 1000
  371. ELSE IF (KERR0.EQ.10) THEN
  372. GOTO 1000
  373. ENDIF
  374. *
  375. * >>>>>>>>>> fin du traitement du materiau
  376. *
  377. * on recupere les caracteristiques geometriques
  378. *
  379. CALL DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  380. . WRK1)
  381. *
  382. *
  383. * quelques impressions si iimpi = 99
  384. *
  385. * IF(IIMPI.EQ.99) THEN
  386. * WRITE(IOIMP,66770) IB,IGAU
  387. *66770 format(////////2x,'element ',i6,2x,'point ',i3//)
  388. * WRITE(IOIMP,66771) MATE,INPLAS,NMATT,NVARI
  389. *66771 format('0 mate=',i4,' inplas=',i4,' nmatt=',i4,' nvari=',i4/)
  390. * WRITE(IOIMP,66772) (SIG0(I),I=1,NSTRS)
  391. *66772 format(2x,' sig0 '/(6(1x,1pe12.5)))
  392. * WRITE(IOIMP,66773) (VAR0(I),I=1,NVARI)
  393. *66773 format(2x,' var0 '/(6(1x,1pe12.5)))
  394. * WRITE(IOIMP,66774) (DEPST(I),I=1,NSTRS)
  395. *66774 format(2x,' depst '/(6(1x,1pe12.5)))
  396. * WRITE(IOIMP,66775) (XMAT(I),I=1,NMATT)
  397. *66775 format(2x,' xmat '/(6(1x,1pe12.5)))
  398. * IF(IVACAR.NE.0)THEN
  399. * WRITE(IOIMP,66776) (XCAR(I),I=1,ICARA)
  400. *66776 format(2x,' xcar '/(6(1x,1pe12.5)))
  401. * ENDIF
  402. * ENDIF
  403. *
  404. * mise à disposition des temperatures tini tfin tref
  405. * aux points de gauss
  406. *
  407. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  408. IBMN=MIN(IB,MELVA3.VELCHE(/2))
  409. IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  410. TETA1=MELVA3.VELCHE(IGMN,IBMN)
  411. IBMN=MIN(IB,MELVA4.VELCHE(/2))
  412. IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  413. TETA2=MELVA4.VELCHE(IGMN,IBMN)
  414. IBMN=MIN(IB,MELVA5.VELCHE(/2))
  415. IGMN=MIN(IGAU,MELVA5.VELCHE(/1))
  416. TETREF=MELVA5.VELCHE(IGMN,IBMN)
  417. ENDIF
  418. ****************************
  419. * SPECIAL SUCCION
  420. *
  421. IF (ITHHER.EQ.3) THEN
  422. IBMN=MIN(IB,MELVA3.VELCHE(/2))
  423. IGMN=MIN(IGAU,MELVA3.VELCHE(/1))
  424. SUCC1=MELVA3.VELCHE(IGMN,IBMN)
  425. IBMN=MIN(IB,MELVA4.VELCHE(/2))
  426. IGMN=MIN(IGAU,MELVA4.VELCHE(/1))
  427. SUCC2=MELVA4.VELCHE(IGMN,IBMN)
  428. ENDIF
  429. ****************************
  430. *
  431. *---------------------------------------------------------------------
  432. *
  433. * ecoulement selon les modeles
  434. *
  435. *---------------------------------------------------------------------
  436. *
  437. MPTVAL=IVAMAT
  438. IF (INPLAS.EQ.66) THEN
  439. C
  440. C
  441. C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES,
  442. C DEFORMATION PLANES ET AXISYMETRIE
  443. C
  444. iwrk12=0
  445. CALL BEINSA(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVAL,NMATT,
  446. 1 SIGF,VARF,KERRE,MELE,IFOURB,NVARI,XCAR,NCARR,MFR,
  447. 2 EPIN0,EPINF,DT,XE,NBNN,CMATE,IB,IGAU,iwrk12)
  448. *
  449. *
  450. ELSEIF (INPLAS.EQ.67) THEN
  451. C
  452. C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE)
  453. C
  454. MVEL1= nint(XMAT(NMATR))
  455. CALL COTROR(WRK0,WRK2,NCOURB,MVEL1,KERRE)
  456. LT1=NCOURB*2
  457. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,
  458. 1 TRAC,LT1,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOURB)
  459. *
  460. *
  461. ELSEIF (INPLAS.EQ.68) THEN
  462. C
  463. C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE)
  464. C
  465. NCOURB=3
  466. KERRE = 0
  467. TRAC(1)=0.D0
  468. TRAC(2)=0.D0
  469. TRAC(3)=XMAT(NMATR)
  470. TRAC(4)=XMAT(NMATR)/XMAT(1)
  471. TRAC(5)=XMAT(NMATR)
  472. TRAC(6)=1.D0
  473. IF(XMAT(NMATR).EQ.0.D0) KERRE = 33
  474. LT1=NCOURB*2
  475. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,
  476. 1 TRAC,LT1,MFR,NVARI,CMATE,XCAR,DDHOOK,NCARR,IFOURB)
  477. C
  478. ELSEIF (INPLAS.EQ.69) THEN
  479. C
  480. C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO
  481. C
  482. ****************************
  483. * SPECIAL SUCCION
  484. *
  485. nnecou=0
  486. CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,
  487. 1 XMAT,SIG0,VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,
  488. 2 SUCC1,SUCC2,NNECOU)
  489. IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  490. KERR1=1
  491. END IF
  492. C
  493. ELSEIF (INPLAS.EQ.71) THEN
  494. C
  495. C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD
  496. C
  497. inecou=0
  498. CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,
  499. 1 XMAT,SIG0,VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,
  500. 2 SUCC1,SUCC2,inecou)
  501. IF((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  502. KERR1=1
  503. END IF
  504. ****************************
  505. C
  506. ELSEIF (INPLAS.EQ.72) THEN
  507. C
  508. C MODELE INFILL_UNI
  509. C
  510. IF (MFR.EQ.27) THEN
  511. C
  512. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  513. C
  514. CALL COTRAI(WRK0,WRK2,12,1,0, NPOINT,KERRE)
  515. NCOURB=NPOINT/2
  516. IF(KERRE.EQ.0) THEN
  517. CALL INFILL(WRK0,WRK1,WRK2,NCOURB,KERRE)
  518. END IF
  519. ELSE
  520. KERRE = 99
  521. ENDIF
  522. C
  523. ELSE IF (INPLAS.EQ.73)THEN
  524. C
  525. C MODELE ETAGE
  526. C pour le moment, element de barre
  527. *
  528. IF (MFR.EQ.7) THEN
  529. C
  530. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  531. C
  532. IPOS1=1
  533. CALL COTRAI(WRK0,WRK2,12,IPOS1,0, NPOINT,KERRE)
  534. NTRAP=NPOINT/2
  535. IPOS2=IPOS1+NPOINT
  536. CALL COTRAI(WRK0,WRK2,13,IPOS2,0, NPOINT,KERRE)
  537. NTRAN=NPOINT/2
  538. IF(KERRE.EQ.0) THEN
  539. CALL ETAGE(WRK0,WRK1,WRK2,NTRAP,NTRAN,KERRE)
  540. END IF
  541. ELSE
  542. KERRE = 99
  543. ENDIF
  544. C
  545. ELSEIF (INPLAS.EQ.99) THEN
  546.  
  547. C
  548. C
  549. C modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES,
  550. C DEFORMATION PLANES ET AXISYMETRIE
  551. C
  552. CALL URGCST(WRK0,WRK1,WRK4,NSTRSS,NMATT,
  553. 1 KERRE,MELE,IFOURB,NCARR,MFR,
  554. 2 DT,TEMP0,CMATE,IB,IGAU,LCAR,0)
  555. c
  556. ELSEIF (INPLAS.EQ.101) THEN
  557. C
  558. C modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES,
  559. C DEFORMATION PLANES ET AXISYMETRIE
  560. C
  561. CALL URGCST(WRK0,WRK1,WRK4,NSTRSS,NMATT,
  562. 1 KERRE,MELE,IFOURB,NCARR,MFR,
  563. 2 DT,TEMP0,CMATE,IB,IGAU,LCAR,2)
  564. *
  565. C
  566. ELSE
  567. KERRE=99
  568. ENDIF
  569. *
  570. * Erreurs
  571. * - problèmes de convergence
  572. *
  573. CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC)
  574. *
  575. * - autres problèmes
  576. *
  577. 1990 CALL DEFER2(INPLAS,MFR,MELE,IB,IGAU,
  578. . KERR1,KERRE)
  579. IF(MFR.EQ.49.OR.INPLAS.EQ.66) THEN
  580. KERR1=0
  581. KERRE=0
  582. LOGSUC=.TRUE.
  583. ENDIF
  584. *
  585. *
  586. 1998 IF(KERRE.NE.0) THEN
  587. IF (LOGVIS) SEGSUP WRK8
  588. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  589. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN
  590. SEGSUP WRK4
  591. ENDIF
  592. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  593. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  594. 1 .OR.MFR.EQ.33)) THEN
  595. SEGDES MINTE2
  596. SEGSUP WRK22
  597. ENDIF
  598. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  599. SEGDES MELVA3
  600. SEGDES MELVA4
  601. SEGDES MELVA5
  602. SEGDES MCHAM3
  603. SEGDES MCHAM4
  604. SEGDES MCHAM5
  605. ENDIF
  606. ****************************
  607. * SPECIAL SUCCION
  608. *
  609. IF (ITHHER.EQ.3) THEN
  610. SEGDES MELVA3
  611. SEGDES MELVA4
  612. SEGDES MCHAM3
  613. SEGDES MCHAM4
  614. ENDIF
  615. ****************************
  616. RETURN
  617. ENDIF
  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. *
  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. SEGSUP WRK0,WR00,WRK1,WRK2,WRK3,WRK5,WTRAV
  650. IF(MFR.EQ.7.OR.MFR.EQ.13.OR.LUNI1.OR.INPLAS.EQ.66) THEN
  651. SEGSUP WRK4
  652. ENDIF
  653. IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  654. 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.31
  655. 1 .OR.MFR.EQ.33)) THEN
  656. SEGDES MINTE2
  657. SEGSUP WRK22
  658. ENDIF
  659. *
  660. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  661. SEGDES MELVA3
  662. SEGDES MELVA4
  663. SEGDES MELVA5
  664. SEGDES MCHAM3
  665. SEGDES MCHAM4
  666. SEGDES MCHAM5
  667. ENDIF
  668. ****************************
  669. * SPECIAL SUCCION
  670. *
  671. IF (ITHHER.EQ.3) THEN
  672. SEGDES MELVA3
  673. SEGDES MELVA4
  674. SEGDES MCHAM3
  675. SEGDES MCHAM4
  676. ENDIF
  677. ****************************
  678. *
  679. RETURN
  680. END
  681.  
  682.  
  683.  
  684.  
  685.  
  686.  
  687.  
  688.  
  689.  
  690.  
  691.  
  692.  
  693.  
  694.  
  695.  
  696.  
  697.  
  698.  
  699.  
  700.  
  701.  
  702.  
  703.  
  704.  
  705.  
  706.  
  707.  
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718.  

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