Télécharger ecoinc.eso

Retour à la liste

Numérotation des lignes :

  1. C ECOINC SOURCE BP208322 17/03/01 21:17:06 9325
  2. SUBROUTINE ECOINC(SIG0,DEPST,DDAUX,CMATE,VALMAT,VALCAR,N2EL,
  3. . N2PTEL,VARIN0,VAREX0,VAREXF,XMAT,PRECIS,WORK,CARAC,TRAC,
  4. . SIGF,VARINF,DEFP,KERRE,MFR,IB,IGAU,NSTRS,EPAIST,MELE,NPINT,
  5. . NBPGAU,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,
  6. . ROTHOO,DDHOMU,CRIGI,DSIGT,INPLAS)
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. C---------------------------------------------------------------------
  10. C ECOULEMENT PLASTIQUE POUR UN POINT
  11. C D 'APRES INCA
  12. C---------------------------------------------------------------------
  13. C
  14. C EN ENTREE :
  15. C
  16. C SIG0 CONTRAINTES AU DEBUT DU PAS
  17. C DEPST INCREMENT DE DEFORMATIONS TOTALES
  18. C ( THERMIQUE ENLEVEE )
  19. C VARIN0 VARIABLES INTERNES DEDUT DU PAS
  20. C VAREX0 VARIABLES EXTERNES DEBUT DU PAS
  21. C VAREXF VARIABLES EXTERNES FIN DU PAS
  22. C XMAT COEFFICIENTS DU MATERIAU
  23. C PRECIS PRECISION POUR ITERATIONS INTERNES
  24. C CARAC DES CARACTERISTIQUES
  25. C TRAC COURBE DE TRACTION
  26. C MFR INDICE DE FORMULATION
  27. C NSTRS NOMBRE DE CONTRAINTES CA2000
  28. C INPLAS NUMERO DU MODELE DE PLASTICITE
  29. * DDAUX = MATRICE DE HOOKE ELASTIQUE
  30. * CMATE = NOM DU MATERIAU
  31. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  32. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  33. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  34. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  35. * IFOU = OPTION DE CALCUL
  36. * IB = NUMERO DE L ELEMENT COURANT
  37. * IGAU = NUMERO DU POINT COURANT
  38. * EPAIST= EPAISSEUR
  39. * NBPGAU= NBRE DE POINTS DE GAUSS
  40. * MELE = NUMERO DE L ELEMENT FINI
  41. * NPINT = NBRE DE POINTS D INTEGRATION
  42. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  43. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  44. * SECT = SECTION
  45. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  46. * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
  47. * UTILISES POUR LE CALCUL DE LA MATRICE DE HOOKE
  48. C
  49. C EN SORTIE :
  50. C
  51. C SIGF CONTRAINTES A LA FIN DU PAS
  52. C VARINF VARIABLES INTERNES FIN DU PAS
  53. C DEFP INCR. DE DEFORMATIONS PLASTIQUES
  54. C KERRE CODE D'ERREUR
  55. C = 0 SI TOUT OK
  56. C = 99 SI FORMULATION NON DISPONIBLE
  57. C EN PLASTICITE
  58. C = 1 SI DEPS EST NEGATIF
  59. C = 2 SI NOMBRE MAX D'ITERATIONS INTERNES DEPASSE
  60. C EN FLUAGE
  61. C = 3 DIMINUER LE PAS ( FLUAGE RUNGE )
  62. C = 4 DEPS EST NEGATIF
  63. C = 5 PAS DE CONVERGENCE INTERNE ( ANCIEN NSTOP=0 )
  64. C = 6 MATRICE SINGULIERE DANS CHAFLU
  65. C EN PLUS
  66. C = 7 PROBLEME DANS LES CARACT DU TUYAU
  67. C = 49 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
  68. C = 51 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
  69. C = 52 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
  70. C = 53 PB DANS LES ITER. INTERNES DRUCKER-PRAGER
  71. C = 75 PB AVEC LA COURBE DE TRACTION
  72. C
  73. C-----------------------------------------------------------------------
  74. C VARIABLES PASSEES PAR LES COMMON ECOU ET NECOU
  75. C
  76. C IFOUR INDICE DU TYPE DE PROBLEME
  77. C -2 CONTRAINTES PLANES
  78. C -1 DEFORMATIONS PLANES
  79. C 0
  80. C N SERIE DE FOURIER
  81. C IMAPLA INDICE DE MATERIAU PLASTIQUE
  82. C 0 MATERIAU ELASTIQUE
  83. C 4 MODELE DE CHABOCHE
  84. C 5 MODELE DE DRUCKER-PRAGER
  85. C 7 MODELE DE ROUSSELIER
  86. C ITYP TYPE DE FORMULATION MECANIQUE
  87. C ITYP=1 CAS DES ELEMENTS MASSIFS
  88. C ITYP=2 CAS DES COQUES
  89. C ITYP=3 CAS DES MEMBRANES
  90. C ITYP=4 CAS DES CABLES ET DES BARRES
  91. C ITYP=5 CAS QUELCONQUE
  92. C ITYP=6 CAS DES CONTRAINTES PLANES
  93. C ITYP=7 CAS DES COQUES A NU=0. OU CONTRAINTES PLANES
  94. C ITYP=8 CAS DES MEMBRANES A NU=0. OU CONTRAINTES PLANES C ITYP=9 CAS DES COQUES EPAISSES
  95. C ITYP=10 CAS DES JOINTS
  96. C ITYP=11 CAS DES POUTRES
  97. C ITYP=12 CAS DES TUYAUX
  98. C ITYP=13 CAS DES COQUES AVEC CISAILLEMENT TRANSVERSE
  99. C IBI 1 SI ERREUR DANS TRACTI , 0 SINON
  100. C IPLAST 1 SI ON A PLASTIFIE , 0 SINON
  101. C ICINE = 1 ECROUISSAGE CINEMATIQUE ( CHABOCHE COMPRIS )
  102. C JFLUAG = 1 ON FLUE AVEC SIGMA
  103. C JFLUAG = 2 ON FLUE AVEC (SIG-X)
  104. C LFLUAG = 0 ON ECROUIT EN CAS DE FLUAGE
  105. C LFLUAG = 1 ON N'ECROUIT PAS EN CAS DE FLUAGE
  106. C JNTRIN = 0 LE TEMPS INTRINSEQUE EST LE TEMPS REEL
  107. C JNTRIN = 1 ON EVOLUE LE TEMPS INTRINSEQUE EN PLASTICITE ET FLUAGE
  108. C JNTRIN = 2 ON N'EVOLUE LE TEMPS INTRINSEQUE QU'EN FLUAGE
  109. C JNTRIN = 3 ON EST EN PLASTICITE ISOCHRONE
  110. C
  111. C TETI = TEMPERATURE AU DEBUT DU PAS
  112. C TET = TEMPERATURE A LA FIN DU PAS
  113. C-----------------------------------------------------------------------
  114. -INC CCOPTIO
  115. COMMON/ECOU/TEST,ALFAH,
  116. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  117. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  118. 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  119. 2 SIPLAD(6),DSIGP0(6),TET,TETI
  120. C
  121. COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  122. . ITYP,IFOURB,IFLUAG,
  123. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  124. . JFLUAG,LEGAUS,LFLUAG,
  125. . IRELAX,JNTRIN,MFLUAG,JELEM,JGRDEF
  126. C
  127. DIMENSION SIG0(*),DEPST(*),SIGF(*),VARIN0(*),VARINF(*),XMAT(*),
  128. . VAREX0(*),VAREXF(*),DEFP(*),CARAC(*),TRAC(*),WORK(*)
  129. DIMENSION SIGMA(6),DSIGMA(6),SPHER(6),AUXIL(6),COEF(40)
  130. DIMENSION DIV(7),SIGFIN(6),DEFPLA(6),DSIGT(*)
  131. DIMENSION TABID(6),TABID2(6)
  132. DIMENSION DDAUX(LHOOK,*),TXR(IDIM,*),CRIGI(*)
  133. DIMENSION VALMAT(*),VALCAR(*),DDHOMU(LHOOK,*)
  134. DIMENSION XLOC(3,3),XGLOB(3,3)
  135. DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
  136. CHARACTER*8 CMATE
  137. C ZZZZZZZZZZZZZZZZZZZZZZZ
  138. C DIMENSIONS A REVOIR
  139. C ZZZZZZZZZZZZZZZZZZZZZ
  140. DIMENSION DHOOK(1),SIG(130),EPS(130)
  141. DIMENSION ORMAT(1),ANORM(1)
  142. DIMENSION DSIGZE(6),DETFNO(1)
  143. DATA ITMAX/15/
  144. DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  145. DATA A,B,C,D/.577350269D0,.7071067814D0,.4082482904D0,
  146. . -0.8164965808D0/
  147. DATA A1/1.D0/
  148. DATA A2/.5D0/
  149. DATA A3/3.D0/
  150. DATA COEF/0.D0,1.5D0,1.5D0,3.D0,3.D0,3.D0,0.5D0,1.5D0,3.D0,0.5D0,
  151. . 1.5D0,3.D0,0.D0,0.D0,1.D0,0.D0,0.D0,0.D0,1.D0,
  152. . 1.D0,1.D0,2.D0,2.D0,2.D0,0.5D0,1.5D0,0.D0,3.D0,
  153. . 1.D0,0.D0,0.D0,1.D0,1.D0,1.D0,0.5D0,1.5D0,0.D0,3.D0,3.D0,3.D0/
  154. DATA XRF/0.0001D0/
  155. C-----------------------------------------------------------------------
  156. C CONVENTION DE REMPLISSAGE DES MEMOIRES
  157. C-----------------------------------------------------------------------
  158. C
  159. C XMAT(1) MODULE D'YOUNG
  160. C XMAT(2) COEFFICIENT DE POISSON
  161. C
  162. C TRAC(1 A 2*NCOURB) COURBE DE TRACTION
  163. C CARAC( " +1) ALFAH POUR COQUES PLASTICITE GLOBALE
  164. C CARAC( " +..) DONNEES POUR CRITERE POUTRES GLOBALES
  165. C
  166. C MODELE ISOTROPE
  167. C VARIN0(1) EPS*
  168. C
  169. C MODELE CINEMATIQUE LINEAIRE
  170. C VARIN0(1) EPS*
  171. C VARIN0(2) A VARIN0(1+IBOU) DEPLACEMENT DE LA SPHERE
  172. C
  173. C MODELE CHABOCHE
  174. C XMAT(5) .... COEFFICIENTS A,C,...
  175. C VARIN0(1) EPS*
  176. C VARIN0(2) A VARIN0(1+IBOU) DEPLACEMENT DE LA SPHERE 1
  177. C VARIN0(2+IBOU) A VARIN0(1+2*IBOU) " " " " 2
  178. C ICENT2 = 1 SI ON A 2 CENTRES
  179. C
  180. C MODELE DRUCKER-PRAGER
  181. C XMAT(5) .... XMAT(13) = LES CONSTANTES DU MODELE
  182. C VARIN0(1) EPS*
  183. C
  184. C MODELE ROUSSELIER
  185. C
  186. C MODELE DE CYCLAGE
  187. C
  188. C MODELE A TEMPS INTRINSEQUE ( FLUAGE ET PLASTICITE ISOCHRONE )
  189. C VARIN0(.) TIMEXI TEMPS INTRINSEQUE DE DEBUT DE PAS
  190. C
  191. C--------------------------------------------------------------------
  192. C REMPLISSAGE
  193. C-----------------------------------------------------------------------
  194. YUNG=XMAT(1)
  195. XNU =XMAT(2)
  196. C
  197. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  198. C REMPLISSAGE A ACTUALISER SELON LES MODELES
  199. CZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  200. CZZZZZZZZZZZZZZZZZZZZZZ
  201. C VARIABLES A RECUPERER
  202. CZZZZZZZZZZZZZZZZZZZZZZ
  203. C ORMAT MATERIAU ORTHOTROPE DANS XMAT
  204. C ANORM A VOIR DANS XMAT OU DANS VARIN
  205. C EPENT DANS VARIN
  206. C VECPRO,VALPRO DANS XMAT
  207. C COVNMS,CVNMSD DANS XMAT ( SELON LES CAS )
  208. C
  209. C IT DANS VAREXT
  210. C EPSFLU DANS VARINT
  211. C SIG,EPS DANS XMAT
  212. C DETFNO DANS VARIN ????
  213. C DSIGZE DANS VARIN ( POUR FLUAGE RELAX )
  214. C SIPLAD DANS VARIN ( POUR FLUAGE RELAX ) ...
  215. C ... ( CE SONT LES DEFORMATIONS OU CONTRAINTES (A VOIR) PLASTIQUES
  216. C AU DEBUT DU PAS )
  217. C TEMPS , HPAS DANS VAREXT
  218. C TET,TETI DANS VAREXT
  219. C
  220. EPSM1=VARIN0(1)
  221. TIMEXI=VARIN0(1)
  222. DPSM1=VARIN0(1)
  223. DPSM2=VARIN0(1)
  224. EPENT=VARIN0(1)
  225. EPSFLU=VARIN0(1)
  226. DETFNO(1)=VARIN0(1)
  227. DSIGZE(1)=VARIN0(1)
  228. TEMPS0=VAREX0(1)
  229. IT=nint(VAREX0(3))
  230. TEMPS=VAREXF(1)
  231. TETI=VAREX0(2)
  232. TET =VAREXF(2)
  233. IF(NCOURB.EQ.0) GO TO 5634
  234. DO 292 I=1,NCOURB
  235. SIG(I)=TRAC(2*I-1)
  236. 292 EPS(I)=TRAC(2*I)
  237. 5634 CONTINUE
  238. ORMAT(1)=XMAT(1)
  239. DHOOK(1)=XMAT(1)
  240. C----------------------------------------------------------------------
  241. C INITIALISATIONS
  242. C----------------------------------------------------------------------
  243. KERRE=0
  244. JA=1
  245. JC=1
  246. IA=1
  247. C
  248. C PETIT TEST SUR NU POUR CERTAINS CAS
  249. C
  250. IF(MFR.EQ.3.AND.IFOURB.EQ.-2.AND.XNU.NE.0.D0) THEN
  251. KERRE=38
  252. RETURN
  253. ENDIF
  254. CZZZZZZZZZZZZZ
  255. C PROVISOIRE
  256. CZZZZZZZZZZZZ
  257. ANORM(1)=XMAT(5)
  258. ICENT2=0
  259. IF(INPLAS.EQ.12.OR.INPLAS.EQ.13) ICENT2=1
  260. IF(INPLAS.EQ.7) NUMCHA=1
  261. IF(INPLAS.EQ.11) NUMCHA=2
  262. IF(INPLAS.EQ.12) NUMCHA=3
  263. IF(INPLAS.EQ.13) NUMCHA=4
  264. C
  265. TEST=0.5D00*PRECIS
  266. HPAS=TEMPS-TEMPS0
  267. MCOD=1
  268. *
  269. * CALCUL DE DSIGT
  270. *
  271. CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,VALCAR,
  272. 1 N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST,
  273. 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  274. 3 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  275. *
  276. IF(IRTD.NE.1) THEN
  277. KERRE=69
  278. GOTO 1000
  279. ENDIF
  280. *
  281. * TRAITEMENT DES COQ2 ET MASSIF 2D EN CAS DE MATERIAU
  282. * UNIDIRECTIONNEL
  283. *
  284. * LES VARIABLES INTERNES SONT DANS LE REPERE UNIDIRECTIONNEL
  285. * ON SE LIMITE AU CAS AXISYMETRIQUE ?
  286. *
  287. IF (CMATE.EQ.'UNIDIREC'.AND.INPLAS.NE.0) THEN
  288. IF(MELE.EQ.44.OR.(MFR.EQ.1.AND.IFOURB.LE.0)) THEN
  289. APHI=0.D0
  290. *
  291. * CAS MASSIF : ON AJOUTE L'ANGLE DU REPERE
  292. * DE L'ELEMENT AVEC LE REPERE GLOBAL
  293. *
  294. IF(MFR.EQ.1) APHI=ATAN2(TXR(2,1),TXR(1,1))
  295. DO 1996 I=1,NSTRS
  296. TABID(I)=SIG0(I)
  297. TABID2(I)=DSIGT(I)
  298. 1996 CONTINUE
  299. ANG = ATAN2(XMAT(4),XMAT(3)) + APHI
  300. CALL CHREP2(TABID,SIG0,ANG,NSTRS,MFR,1,KERRE)
  301. CALL CHREP2(TABID2,DSIGT,ANG,NSTRS,MFR,1,KERRE)
  302. IF(KERRE.NE.0) RETURN
  303. ELSEIF(MFR.EQ.1.AND.IFOURB.EQ.2) THEN
  304. DO 996 I=1,NSTRS
  305. TABID(I)=SIG0(I)
  306. TABID2(I)=DSIGT(I)
  307. 996 CONTINUE
  308. CALL CHREP3(TABID,SIG0,XMAT,TXR,NSTRS,1,1,KERRE)
  309. CALL CHREP3(TABID2,DSIGT,XMAT,TXR,NSTRS,1,1,KERRE)
  310.  
  311. ENDIF
  312. ENDIF
  313. *
  314. iecou=0
  315. inecou=0
  316. CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL,
  317. . SIGF,DEFP,VARINF,SIGFIN,DEFPLA,
  318. . DSIGZE,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE
  319. > ,iecou,inecou)
  320.  
  321. IF(ITYP.EQ.0) THEN
  322. KERRE=99
  323. RETURN
  324. ENDIF
  325. C-----------------------------------------------------------------------
  326. EI=YUNG
  327. UNSYG=1.D00/YUNG
  328. U5SNU=1.5D00/(1.D00+XNU)
  329. U5DMU=U5SNU*YUNG
  330. SREF=YUNG*XRF
  331. IPLAST=0
  332. LCGDF=36
  333. LPLUS=6
  334. ITER=1
  335. LAPOIN=0
  336. C
  337. C CAS DES COQUES EN GLOBAL - ON RECUPERE LE ALFAH
  338. C
  339. ALFAH=1.D0
  340. IF(ITYP.EQ.2) ALFAH=CARAC(2)**2
  341. IF(ITYP.EQ.7) ALFAH=CARAC(2)**2
  342. UNALF=0.D0
  343. IF(ALFAH.GE.1.D-12) UNALF=1.D0/ALFAH
  344. C
  345. C CAS DES BARRES ET DES CABLES
  346. C
  347. IF(ITYP.EQ.4) THEN
  348. DIV(1)=1.D0
  349. DIV(2)=1.D0
  350. DIV(3)=1.D0/CARAC(1)
  351. ENDIF
  352. C
  353. C CAS DES POUTRES
  354. C
  355. IF(ITYP.NE.11) GO TO 841
  356. DIV(1)=1.D0/CARAC(4)
  357. DIV(2)=1.D0
  358. DIV(3)=1.D0
  359. DIV(4)=CARAC(10)/CARAC(1)
  360. DIV(5)=CARAC(11)/CARAC(2)
  361. DIV(6)=CARAC(12)/CARAC(3)
  362. IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(CARAC(1)*CARAC(4))
  363. IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(CARAC(2)*CARAC(4))
  364. IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(CARAC(3)*CARAC(4))
  365. GO TO 761
  366. 841 CONTINUE
  367. C
  368. C CAS DES TUYAUX
  369. C
  370. IF(ITYP.NE.12) GO TO 842
  371. EPAIS=CARAC(1)
  372. REXT=CARAC(2)
  373. RMOY=REXT-EPAIS*0.5D0
  374. RACO=CARAC(3)
  375. GAM=1.D0
  376. XK=1.D0
  377. IF(RACO.EQ.0.D0) GO TO 765
  378. XLAM=RMOY*RMOY/EPAIS/RACO
  379. XK=1.65D0*XLAM
  380. IF(XK.LT.1.D0) XK=1.D0
  381. GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  382. IF(GAM.LT.1.D0) GAM=1.D0
  383. 765 CONTINUE
  384. C
  385. C NB 23/09/98
  386. C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  387. C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  388. C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  389. C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  390. C DUE A LA PRESSION )
  391. C POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
  392. C DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
  393. C
  394. C
  395. DIV(1)=1.D0
  396. DIV(2)=1.D0
  397. DIV(3)=1.D0
  398. DIV(4)=R33
  399. DIV(5)=PI4*GAM
  400. DIV(6)=DIV(5)
  401. DIV(7)=0.D0
  402. IF(IDIM.EQ.2) THEN
  403. PRES1=CARAC(6)
  404. CISA1=CARAC(7)
  405. IXCAR1=12
  406. IDEB1=8
  407. ELSE IF(IDIM.EQ.3) THEN
  408. PRES1=CARAC(7)
  409. CISA1=CARAC(8)
  410. IXCAR1=13
  411. IDEB1=9
  412. ENDIF
  413. C
  414. JDIV1=2
  415. DO 1515 IBA=IDEB1,IXCAR1
  416. JDIV1=JDIV1+1
  417. VCAR1=CARAC(IBA)
  418. IF (VCAR1.NE.-1.D0) DIV(JDIV1)=CARAC(IBA)
  419. 1515 CONTINUE
  420. C
  421. C NB 23/09/98
  422. C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  423. C 1.D0 DE DIV(3)
  424. C
  425. DIV(1) = DIV(3)
  426. DIV(3)=1.D0
  427. C
  428. VX=CARAC(4)
  429. VY=CARAC(5)
  430. VZ=CARAC(6)
  431. CALL TUYCAR(CARAC,CISA1,VX,VY,VZ,KERRE,2)
  432. IF(KERRE.EQ.0) GO TO 843
  433. KERRE=7
  434. RETURN
  435. 843 CONTINUE
  436. C
  437. C NB 23/09/98
  438. C DIVISION DE DIV(5) ET DIV(6) PAR XK
  439. C CAR TUYCAR SORT LES INERTIES MODIFIEES
  440. C POUR LE CALCUL DES DEFORMATIONS PAR EPSIG
  441. C
  442. DIV(5)=DIV(5)/XK
  443. DIV(6)=DIV(6)/XK
  444. C
  445. DIV(1)=DIV(1)/CARAC(4)
  446. DIV(4)=DIV(4)*RMOY/CARAC(1)
  447. DIV(5)=DIV(5)*RMOY/CARAC(2)
  448. DIV(6)=DIV(6)*RMOY/CARAC(3)
  449. 761 CONTINUE
  450. E(1)=YUNG
  451. E(2)=0.D0
  452. E(3)=0.D0
  453. E(4)=YUNG*1.5D0/(1.D0+XNU)
  454. E(5)=YUNG
  455. E(6)=YUNG
  456. 842 CONTINUE
  457. C
  458. IF(ICINE.EQ.0.OR.JFLUAG.EQ.1) GO TO 204
  459. C
  460. C ON EST EN CINEMATIQUE ( PLASTIQUE OU FLUAGE )
  461. C DANS CE CAS ON FLUE AVEC SIGMA-ALPHA QUE L'ON CALCULE
  462. C
  463. DO 206 IBA=1,IBOU
  464. 206 SIGMA(IBA)=SIGMA(IBA)-SPHER(IBA)
  465. 204 CONTINUE
  466. C
  467. IF(JNTRIN.EQ.0) GO TO 830
  468. TIMEXF=TIMEXI
  469. GO TO 831
  470. 830 TIMEXI=TEMPS-HPAS
  471. TIMEXF=TEMPS
  472. 831 CONTINUE
  473. IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) GO TO 844
  474. DO 845 IBA=1,IBOU
  475. SIGMA(IBA)=SIGMA(IBA)*DIV(IBA)
  476. IF(ICINE.EQ.0) GO TO 845
  477. IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 845
  478. SPHER(IBA)=SPHER(IBA)*DIV(IBA)
  479. 845 DSIGMA(IBA)=DSIGMA(IBA)*DIV(IBA)
  480. 844 CONTINUE
  481. DO 886 IBA=1,IBOU
  482. 886 STOT(IBA)=SIGMA(IBA)+DSIGMA(IBA)
  483. C----------------------------------------------------------------------
  484. C CALCUL DE LA LIMITE ELASTIQUE
  485. C----------------------------------------------------------------------
  486. IF(LFLUAG.EQ.1) GO TO 261
  487. IF(IMAPLA.NE.4) GO TO 262
  488. BPSTAR=EPSM1
  489. ICOD=1
  490. CALL CHALIM(BPSTAR,SELAS,XMAT,TET,ICOD,
  491. . BID,BID,BID,BID,BID1,BID2,BI3,BI4,BI5,BI6,IBID,IBID,NUMCHA)
  492. GO TO 261
  493. 262 IF(IMAPLA.NE.5) GO TO 263
  494. * REMPLACEMENT XMAT(7) PAR XMAT(12) AM 8/3/90
  495. * TEST SELON EPSM1 AM 28/1/91
  496. IF(EPSM1.EQ.0.D0) THEN
  497. SELAS = XMAT(12)
  498. ELSE
  499. SELAS = XMAT(7) + EPSM1 * XMAT(13)
  500. *
  501. * AM 24/5/93 TEST SUR SELAS
  502. *
  503. IF( SELAS.LT.0.D0) THEN
  504. SELAS = 0.D0
  505. ENDIF
  506. *
  507. ENDIF
  508. GO TO 261
  509. 263 CONTINUE
  510. EPSTAR=EPSM1
  511. IF(ICINE.EQ.1) EPSTAR=0.D0
  512. CALL TRACTI(SELAS,EPSTAR,SIG,EPS,NCOURB,2,IBI)
  513. IF(IBI.EQ.1) THEN
  514. KERRE=75
  515. GOTO 1000
  516. ENDIF
  517. *
  518. 261 CONTINUE
  519. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  520. C A VOIR CE QU'IL Y A DANS ANORM
  521. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  522. IF(IMAPLA.EQ.7) COVNMS(1)=ANORM(2*JC-1)
  523. IF(IMAPLA.EQ.7.AND.IT.EQ.1) ANORM(2*JC)=1.D-20
  524. *
  525. * SI MATERIAU DRUCKER PRAGER ON CHERCHE LE CRITERE
  526. * AVEC LEQUEL ON DOIT FAIRE LA PROJECTION ET LE CRITERE
  527. IXMAT=5
  528. IF(IMAPLA.EQ.5.AND.EPSM1.EQ.0.D0) IXMAT=10
  529. CALL CKRIT(IMAPLA,STOT,ITYP,XMAT(IXMAT),ALFAH,COVNMS,XINV,SSTAR)
  530. SJ1=XINV(1)
  531. SJ2=XINV(2)
  532. IF(IMAPLA.EQ.0) GO TO 3
  533. IF(JFLUAG.NE.0) GO TO 4
  534. C---------------------------------------------------------------------
  535. C A T'ON DEPASSE LA LIMITE ELASTIQUE
  536. C---------------------------------------------------------------------
  537. PETI=1.1D00*TEST*SSTAR
  538. CALL EPSPRE(SSTAR,SELAS,PETI,ITRY)
  539. IF(ITRY.EQ.0.AND.SSTAR.GT.SELAS) GO TO 4
  540. C----------------------------------------------------------------------
  541. C ON N'A PAS PLASTIFIE
  542. C----------------------------------------------------------------------
  543. 3 CONTINUE
  544. IF(ITYP.EQ.11.OR.ITYP.EQ.12.OR.ITYP.EQ.4) THEN
  545. DO 447 IBA=1,IBOU
  546. IF(ICINE.NE.0) SPHER(IBA)=SPHER(IBA)/DIV(IBA)
  547. 447 STOT(IBA)=STOT(IBA)/DIV(IBA)
  548. ENDIF
  549. DO 32 IBA=1,IBOU
  550. SIGFIN(IBA)=STOT(IBA)
  551. DEFPLA(IBA)=0.D0
  552. 32 DSIGMA(IBA)=0.D0
  553. STARF=SSTAR
  554. EPST=EPSM1
  555. GO TO 31
  556. C----------------------------------------------------------------------
  557. C ON A PLASTIFIE
  558. C----------------------------------------------------------------------
  559. 4 CONTINUE
  560. IPLAST=1
  561. PENTE=0.D0
  562. SLOPE=0.D0
  563. DO 360 IBA=1,IBOU
  564. 360 W1(IBA)=SIGMA(IBA)
  565. CALL CKRIT(IMAPLA,W1,ITYP,XMAT(5),ALFAH,COVNMS,XINV,S0)
  566. EPSTAR=EPSM1
  567. C
  568. C EN FLUAGE SI ON LA VITESSE DE FLUAGE NE DEPEND QUE
  569. C DU EPSILON EQUIVALENT DE FLUAGE CUMULE ON VA LE LIRE DANS EPSFLU
  570. C
  571. IF(JFLUAG.NE.0.AND.IFLUPL.EQ.1) EPSTAR=EPSFLU
  572. EPSIN=EPSTAR
  573. SEL=0.D0
  574. SPLA=1.D0
  575. IF(JFLUAG.NE.0) GO TO 70
  576. CALL SIGELP(SIGMA,DSIGMA,SIGEL,DSIGP,STOT,PETI,
  577. . ITYP,SEL,SPLA,IBOU,S0,SELAS,XMAT(5),COVNMS,ALFAH,
  578. . IMAPLA,SSTAR)
  579. CALL SHIFTD(SIGEL,DALPHA,IBOU)
  580. GO TO 2333
  581. C
  582. 70 CONTINUE
  583. C
  584. DO 7 IBA=1,IBOU
  585. SIGEL(IBA)=SIGMA(IBA)+SEL*DSIGMA(IBA)
  586. DALPHA(IBA)=SIGEL(IBA)
  587. 7 DSIGP(IBA)=SPLA*DSIGMA(IBA)
  588. 2333 CONTINUE
  589. DTIMEX=SPLA*HPAS
  590. IF(JNTRIN.EQ.1.OR.JNTRIN.EQ.3) TIMEXF=TIMEXI+DTIMEX
  591. C
  592. C CALCUL DES PENTES
  593. C
  594. IF(ABS(SPLA).LT.0.95D00) IELPLA=0
  595. IF(ICYCL.NE.1) GO TO 71
  596. C
  597. C CAS DES MODELES DE CYCLAGE
  598. C
  599. CALL NORMAL(A1,A2,A3,SIGEL,W1,ALFAH,SELAS,IBOU,ITYP)
  600. CZZZZZZZZZZZZZZZZZZZZZZ
  601. C ON RECUPERE LA NORMALE DE LA DERNIERE SORTIE
  602. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  603. DO 721 IBA=1,IBOU
  604. 721 W2(IBA)=ANORM(IBA)
  605. C
  606. C CALCUL DU PRODUIT SCALAIRE DE LA NORMALE AU POINT OU ON SORT
  607. C AVEC LA DERNIERE NORMALE OU ON EST SORTI
  608. C
  609. X=SDOT(IBOU,W1,1,W2,1)
  610. C ON STOCKE LA NORMALE
  611. DO 720 IBA=1,IBOU
  612. 720 ANORM(IBA)=W1(IBA)
  613. CZZZZZZZZZZZZZZZZZZZZZZZ
  614. C IL FAUDRA LA STOCKER DANS VARINF AU LIEU DE ANORM
  615. CZZZZZZZZZZZZZZZZZZZZZZZZZ
  616. C
  617. C CALCUL DU EPSI AVEC QUOI CALCULER LA PENTE
  618. C
  619. EPSEN=0.5D00*(X+1.D00)*EPENT
  620. EPSIN=EPSEN
  621. 71 CONTINUE
  622. IF(JFLUAG.EQ.0) GO TO 40
  623. IF(IMAPLA.EQ.4) GO TO 5
  624. C
  625. C INITIALISATIONS POUR LE FLUAGE
  626. C QUEL EST LE EPSILON CUMULE DE FLUAGE
  627. C
  628. SLOPE=0.D0
  629. PENTE=0.D0
  630. IF(ICINE.EQ.0) GO TO 5
  631. IF(JFLUAG.EQ.2) GO TO 40
  632. C
  633. C CAS CINE + FLUAGE : CALCUL DE LA PENTE A LA COURBE DE TRACTION
  634. C
  635. IF(ICINE.EQ.2) EPSIN=EPS(NCOURB)
  636. CALL TRACTI(PENTE,EPSIN,SIG,EPS,NCOURB,1,IBI)
  637. IF(IBI.EQ.1) THEN
  638. KERRE=75
  639. GOTO 1000
  640. ENDIF
  641. *
  642. GO TO 5
  643. 40 CONTINUE
  644. IF(IMAPLA.EQ.5.OR.IMAPLA.EQ.4) GO TO 5
  645. C
  646. C CALCUL DE LA PENTE DE LA COURBE DE TRACTION AU POINT X-EPSTAR
  647. C
  648. SLOPE=0.D0
  649. CALL TRACTI(PENTE,EPSIN,SIG,EPS,NCOURB,1,IBI)
  650. IF(IBI.EQ.1) THEN
  651. KERRE=75
  652. GOTO 1000
  653. ENDIF
  654. *
  655. IF(ICINE.EQ.0) GO TO 5
  656. 6 SLOPE=PENTE
  657. PENTE=0.
  658. PANTIN=SLOPE
  659. IF(ICINE.EQ.1) GO TO 5
  660. EPSIN=EPS(NCOURB)
  661. CALL TRACTI(PANTIN,EPSIN,SIG,EPS,NCOURB,1,IBI)
  662. IF(IBI.EQ.1) THEN
  663. KERRE=75
  664. GOTO 1000
  665. ENDIF
  666. *
  667. PENTE=SLOPE-PANTIN
  668. SLOPE=PANTIN
  669. 5 CONTINUE
  670. IF(IMAPLA.NE.4) GO TO 5621
  671. C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  672. C MODELE CHABOCHE
  673. C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  674. iecou=0
  675. inecou=0
  676. IF(JFLUAG.EQ.0)
  677. . CALL CHABOK(YUNG,XNU,IA,EI,
  678. . XMAT,SPHER,JA,IBOU,SI,DEPS,EPST,EPSTAR,WORK,KERRE,SN,
  679. . AUXIL,NUMCHA,iecou,inecou)
  680. IF(JFLUAG.NE.0)
  681. . CALL CHAFLU(YUNG,XNU,IA,EI,SSTAR,
  682. 1 XMAT,SPHER,IBOU,SI,DEPS,EPST,EPSTAR,WORK,
  683. 2 AUXIL,DPSM1,DPSM2,KERRE,NUMCHA,iecou,inecou)
  684. IF(KERRE.NE.0) RETURN
  685. IF(JFLUAG.NE.0.AND.IMAPLA.EQ.4) GO TO 689
  686. IF(IMAPLA.EQ.4) GO TO 570
  687. 5621 CONTINUE
  688. IF(IMAPLA.NE.5) GO TO 9997
  689. C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  690. C MODELE DRUCKER-PRAGER - PRELIMINAIRES
  691. C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  692. C ON EST DANS LE CAS DU MATERIAU DRUCKER-PRAGER.ON VA FAIRE UN
  693. C TEST POUR SAVOIR SI L'ON DOIT PROJETER AU SOMMET DU CONE ET
  694. C EVENTUELLEMENT FAIRE CETTE PROJECTION.
  695. C DANS CETTE VERSION,LE TEST CONSISTE A SAVOIR SI L'ETAT DE
  696. C CONTRAINTES CALCULE ELASTIQUEMENT SE TROUVE D'UN COTE OU DE
  697. C L'AUTRE D'UN PLAN ORTHOGONAL A L'AXE ET PASSANT PAR LE SOMMET
  698. C DU CONE,PUIS A SAVOIR SI L'ON EST A L'INTERIEUR OU A
  699. C L'EXTERIEUR DU CONE DES NORMALES AU CRITERE DE DRUCKER.
  700. C ON CALCULE LE I1 QUI DELIMITE LES DEUX REGIONS ET ON LE
  701. C COMPARE AVEC LE PREMIER INVARIANT DU TENSEUR CALCULE ELASTIQUEMENT
  702. C
  703. C
  704. C SNN=XMAT(7)+XMAT(13)*EPSTAR
  705. *
  706. * AM 24/5/93 TEST SUR SNN
  707. *
  708. * IF( SNN*XMAT(7).LT.0.D0) THEN
  709. * SNN=0.D0
  710. * XMAT(13)=0.D0
  711. * ENDIF
  712. *
  713. C
  714. C MILL 17/3/93
  715. C SI XMAT(5)=0. PAS DE TEST PAR RAPPORT AU SOMMET
  716. C
  717. C IF(XMAT(5).EQ.0.D0) GO TO 99970
  718. C
  719. C XI1LIM=SNN/XMAT(5)
  720. C IF(SJ1.LE.XI1LIM) GO TO 99970
  721. C
  722. C ON TESTE ENSUITE PAR RAPPORT AU CONE DES NORMALES
  723. C
  724. C TESTDR=-XMAT(9)*SJ1/(2.D0*XMAT(8))+SJ2+XI1LIM*XMAT(9)/
  725. C . (2.D0*XMAT(8)*XMAT(5))
  726. C IF(TESTDR.GT.0.D00)GO TO 99970
  727. C
  728. C ON EST MAINTENANT DANS LE CAS OU L'ON DOIT PROJETER AU SOMMET
  729. C
  730. C CALL SOMDRU(IBOU,SI,DEPS,EPST,EPSTAR,SNN,XMAT(5),YUNG,XNU,KERRE)
  731. C IF(KERRE.NE.0) RETURN
  732. C LAPOIN=1
  733. C GO TO 570
  734. 99970 CONTINUE
  735. CALL SHIFTD(DHOOK,WORK(109),36)
  736. iecou=0
  737. inecou=0
  738. CALL PRJDRU(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,EPSTAR,ITER,
  739. . SN,WORK(109),WORK,WORK(37),WORK(73),XMAT(5),YUNG,
  740. . XNU,LAPOIN,KERRE,iecou,inecou)
  741. IF(KERRE.NE.0) RETURN
  742. GO TO 570
  743. C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  744. C MODELE ROUSSELIER
  745. C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  746. 9997 IF(IMAPLA.EQ.7) THEN
  747. CALL FISSUR
  748. C CALL FISSUR(YUNG,XNU,U5DMU,XMAT(5),A,B,C,ANORM,
  749. C 1 JC,SIG,EPS,SELAS,SSTAR,IBOU,JKI,PENTE,EPSTAR,EPST,ITMAX,COEF,
  750. C 1 IA,S0,SI,DEPS,SN,IMPRI)
  751. GO TO 570
  752. ENDIF
  753. C
  754. IF(IRELAX.EQ.0) GO TO 42
  755. DO 43 IBA=1,IBOU
  756. C
  757. C MODIF DU 18/3/86 ON MET SIPLAD A 0. ( AVANT ON AVAIT DEFP )
  758. C
  759. SIPLAD(IBA)=0.D00
  760. 43 DSIGP0(IBA)=DSIGZE(IBA)
  761. 42 CONTINUE
  762. IF(JGRDEF.LE.1) GO TO 420
  763. C
  764. C INTEGRATION EN GRANDES DEFORMATIONS D N'EST PLUS ISOTROPE
  765. C ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  766. C A VOIR|||||||||||||||||||||||||
  767. CALL SHIFTD(DHOOK,WORK,36)
  768. RAI=DETFNO(1)
  769. CALL T6CDCT
  770. C CALL T6CDCT(CGDFNO((IA-1)*LCGDF+1),WORK,4,W1,RAI)
  771. CALL PRJGDF
  772. C CALL PRJGDF(SSTAR,SELAS,PENTE,IBOU,SI,DEPS,EPST,EPSTAR,
  773. C 1 ITER,SN,TET,WORK,WORK(37),WORK(73),PANTIN,TIMEXF,SIG,EPS,IA,
  774. C 1 WORK(109))
  775. CALL SHIFTD(W1,DEFPLA,6)
  776. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  777. GO TO 570
  778. 420 CONTINUE
  779. C----------------------------------------------------------------------
  780. C ECRITURE SOUS FORME DIAGONALE
  781. C DIAGONALISATION DE SIGEL ET DSIGP
  782. C----------------------------------------------------------------------
  783. NK=1
  784. CALL XYZDIA(DSIGP,SIGEL,W1,W2,A,B,C,D,ITYP,VECPRO)
  785. IF(IRELAX.NE.0)
  786. 1 CALL XYZDIA(SIPLAD,DSIGP0,W1,W2,A,B,C,D,ITYP,VECPRO)
  787. C
  788. GO TO (60,61,61,63,64,65,66,66,68,69,78,79,80),ITYP
  789. C
  790. 80 CONTINUE
  791. C CONTRAINTES PLANES AVEC TOUS LES CISAILLEMENTS
  792. C
  793. RAI=YUNG/(1.D0-XNU*XNU)
  794. E(1)=RAI*(1.D0+XNU)*0.5D0
  795. E(2)=RAI*(1.D0-XNU)*1.5D0
  796. E(3)=0.D0
  797. E(4)=E(2)
  798. E(5)=E(2)
  799. E(6)=E(2)
  800. JKI=34
  801. GO TO 615
  802. C
  803. 79 CONTINUE
  804. C TUYAUX
  805. 78 CONTINUE
  806. C POUTRES
  807. C LE REMPLISSAGE DE E EST FAIT EN AMONT
  808. C
  809. JKI=28
  810. GO TO 615
  811. 69 CONTINUE
  812. GO TO 640
  813. 68 CONTINUE
  814. GO TO 640
  815. 66 CONTINUE
  816. C COQUE OU MEMBRANE A NU =0 OU CP
  817. C
  818. RAI=YUNG
  819. DO 6600 IBA=1,6
  820. 6600 E(IBA)=0.D00
  821. E(1)=RAI
  822. IF(ICINE.NE.0) E(1)=E(1)+SLOPE
  823. E(4)=E(1)*ALFAH
  824. W1(1)=DSIGP(1)/(E(1)+PENTE)
  825. IF(ITYP.EQ.7) THEN
  826. IF(ALFAH.NE.0.D0) THEN
  827. W1(4)=DSIGP(4)/(E(4)+PENTE)
  828. ELSE
  829. W1(4)=0.D0
  830. ENDIF
  831. ENDIF
  832. JKI=18
  833. DEPS=VNMISD(W1,ITYP,ALFAH,COVNMS)
  834. GO TO 640
  835. 65 CONTINUE
  836. C CONTRAINTES PLANES
  837. C
  838. RAI=YUNG/(1.D0-XNU*XNU)
  839. E(1)=RAI*(1.D0+XNU)*0.5D0
  840. E(2)=RAI*(1.D0-XNU)*1.5D0
  841. E(3)=0.D0
  842. E(4)=E(2)
  843. E(5)=E(3)
  844. E(6)=E(3)
  845. JKI=24
  846. GO TO 615
  847. 64 CONTINUE
  848. C MATER QUELCONQUE
  849. C
  850. JKI=18
  851. NK=1
  852. DO 6400 IBA=1,6
  853. 6400 E(IBA)=VALPRO(IBA)
  854. IF(ICINE.EQ.0) GO TO 6401
  855. DO 6402 IBA=1,6
  856. 6402 E(IBA)=E(IBA)+SLOPE
  857. 6401 CONTINUE
  858. DO 6406 IBA=1,6
  859. IF(E(IBA)+PENTE.EQ.0.D00) GO TO 6406
  860. W1(IBA)=DSIGP(IBA)/(E(IBA)+PENTE)
  861. 6406 CONTINUE
  862. DEPS=VNMISD(W1,ITYP,ALFAH,CVNMSD)
  863. GO TO 640
  864. C
  865. 61 RAI=YUNG/(1.D0-XNU*XNU)
  866. E(1)=RAI*(1.D0+XNU)*0.5D0
  867. E(2)=RAI*(1.D0-XNU)*1.5D0
  868. E(3)=E(2)
  869. E(4)=E(1)*ALFAH
  870. E(5)=E(2)*ALFAH
  871. E(6)=E(3)*ALFAH
  872. JKI=6
  873. 615 CONTINUE
  874. IF(ICINE.EQ.0) GOTO 610
  875. DO 611 IK=1,6
  876. 611 E(IK)=E(IK)+SLOPE
  877. 610 CONTINUE
  878. IBO=2
  879. IF(ITYP.EQ.3.OR.ITYP.EQ.6) IBO=1
  880. IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) W1(3)=0.D0
  881. DO 614 I=1,IBOU
  882. IF(ITYP.EQ.6.AND.I.EQ.3) GO TO 614
  883. W1(I)=0.D0
  884. IF(PENTE+E(I).EQ.0.) GO TO 614
  885. W1(I)=DSIGP(I)/(E(I)+PENTE)
  886. 614 CONTINUE
  887. DEPS=VNMISD(W1,ITYP,ALFAH,COVNMS)
  888. GO TO 640
  889. C
  890. 63 E(3)=U5DMU/U5SNU
  891. IF(ICINE.NE.0) E(3)=E(3)+SLOPE
  892. NK=3
  893. JKI=12
  894. E(2)=0.D0
  895. E(1)=0.D0
  896. E(4)=0.D0
  897. E(5)=0.D0
  898. E(6)=0.D0
  899. DEPS=DSIGP(3)/(E(3)+PENTE)
  900. GO TO 640
  901. C
  902. 60 CONTINUE
  903. JKI=0
  904. DO 601 I=1,6
  905. 601 E(I)=U5DMU
  906. E(1)=0.
  907. IF(ICINE.EQ.0) GO TO 603
  908. DO 602 I=1,6
  909. 602 E(I)=E(I)+SLOPE
  910. 603 CONTINUE
  911. EMU=PENTE+U5DMU
  912. RAI=YUNG
  913. IF(IMAPLA.EQ.5) EMU=U5DMU+3*XMAT(5)*XMAT(5)*RAI/(1.D0-2.D0*XNU)
  914. DEPS=(SSTAR-SELAS)/EMU
  915. C
  916. 640 CONTINUE
  917. C
  918. IF(JFLUAG.NE.0) GO TO 41
  919. C-----------------------------------------------------------------------
  920. C PLASTICITE - PROJECTION SUR LA SURFACE DE CHARGE
  921. C-----------------------------------------------------------------------
  922. iecou=0
  923. inecou=0
  924. CALL PROJVM(SIG,EPS,EPST,EPSTAR,DEPS,PENTE,SN,PANTIN,
  925. 1 SELAS,ITER,SO,SSTAR,SI,NK,IBOU,COEF,JKI,KERRE,iecou,inecou)
  926. C
  927. GO TO 57
  928. C-----------------------------------------------------------------------
  929. C FLUAGE
  930. C-----------------------------------------------------------------------
  931. 41 CONTINUE
  932. iecou=0
  933. inecou=0
  934. CALL FLUAGE(ITER,EPSTAR,S0,EPST,SSTAR,SI,DPSM1,DPSM2,
  935. . IBOU,DEPS,ICONV,TIMEXI,TIMEXF,YUNG,KERRE,iecou,inecou)
  936. IF(KERRE.EQ.0) GO TO 8693
  937. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  938. C TESTER KERRE EN SORTIE DE FLUAGE
  939. C ON RECUPERE AUUSI ICONV EN SORTIE
  940. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  941. 8693 CONTINUE
  942. 689 CONTINUE
  943. C-----------------------------------------------------------------------
  944. C ON STOKE LE EPS DE FLUAGE DANS EPSFLU DANS TOUS LES CAS
  945. C-----------------------------------------------------------------------
  946. EPSFLU=EPST
  947. C ON CALCULE LE EPSILON INELASTIQUE CUMULE
  948. C
  949. EPST=EPSM1
  950. IF(LFLUAG.EQ.1) GO TO 414
  951. C ON ECROUIT LE RAYON DE LA SURFACE DE CHARGE
  952. C
  953. EPST=DEPS+EPSM1
  954. 414 CONTINUE
  955. IF(IMAPLA.EQ.4) GO TO 570
  956. IF(ICINE.EQ.0) GO TO 413
  957. IF(LFLUAG.EQ.1) GO TO 57
  958. C CAS CINEMATIQUE
  959. C
  960. SLIM=SELAS
  961. GO TO 57
  962. 413 CONTINUE
  963. C CAS ISOTROPE
  964. C
  965. IF(LFLUAG.EQ.1) GO TO 57
  966. C ON CHERCHE LE NOUVEAU RAYON DE LA SPHERE
  967. C
  968. CALL TRACTI(SF,EPST,SIG,EPS,NCOURB,2,IBI)
  969. IF(IBI.EQ.1) THEN
  970. KERRE=75
  971. GOTO 1000
  972. ENDIF
  973. *
  974. SLIM=SF
  975. C
  976. 57 CONTINUE
  977. C
  978. C----------------------------------------------------------------------
  979. C RETOUR AUX AXES X Y Z
  980. C----------------------------------------------------------------------
  981. CALL DIAXYZ(ITYP,SIGT,SIGEL,VECPRO,IBO,A,B,C,B1,B2)
  982. IF(JFLUAG.EQ.0) GO TO 10
  983. IF((IT.EQ.1.AND.IRELAX.EQ.0).OR.(ICONV.NE.0.AND.IRELAX.NE.0))
  984. . CALL DIAXYZ(ITYP,DSIGP,STOT,VECPRO,IBO,A,B,C,B1,B2)
  985. 10 CONTINUE
  986. C-----------------------------------------------------------------------
  987. C TRAITEMENT FINAL
  988. C-----------------------------------------------------------------------
  989. 570 CONTINUE
  990. EPSM1F=EPST
  991. IF(ICYCL.EQ.1) EPENTF=EPSEN+DEPS
  992. IF(IMAPLA.NE.7) GO TO 9100
  993. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  994. C VOIR SI ON A BESOIN DE SIGT
  995. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  996. DO 9101 IBA=1,IBOU
  997. 9101 SIGT(IBA)=SIGT(IBA)-W1(IBA)
  998. 9100 CONTINUE
  999. IF(ICINE.EQ.0) GO TO 913
  1000. IF(LFLUAG.EQ.1) GO TO 913
  1001. IF(JFLUAG.EQ.1) GO TO 94
  1002. IF(IMAPLA.EQ.4) GO TO 90
  1003. C----------------------------------------------------------------------
  1004. C CAS CINEMATIQUE - CALCUL DE DALPHA
  1005. C----------------------------------------------------------------------
  1006. Z=PANTIN*DEPS/SELAS
  1007. IF(Z.LT.0.01D00) GO TO 910
  1008. EZZ=1.D0-EXP(-Z)
  1009. Z=1.D0-EZZ/Z
  1010. EZZ=EZZ/(1.D0-Z)
  1011. Z=Z/(1.D0-Z)
  1012. DO 91 IBA=1,IBOU
  1013. DALPHA(IBA)=DALPHA(IBA)*EZZ+Z*(SIGEL(IBA)-DALPHA(IBA))
  1014. 91 CONTINUE
  1015. GO TO 90
  1016. 910 DO 911 IBA=1,IBOU
  1017. DALPHA(IBA)=Z*0.5D0*(DALPHA(IBA)+SIGEL(IBA))
  1018. 911 CONTINUE
  1019. GO TO 90
  1020. 94 CONTINUE
  1021. IF(IMAPLA.EQ.4) GO TO 913
  1022. CALL MOVCEN(PENTE,DEPS,SELAS,JA,IBOU,DALPHA,SIGMA,SPHER,SIGEL)
  1023. 90 CONTINUE
  1024. 913 CONTINUE
  1025. C----------------------------------------------------------------------
  1026. C CAS CINEMATIQUE COORDONNEES DU NOUVEAU CENTRE DE LA SPHERE
  1027. C----------------------------------------------------------------------
  1028. IF(ICINE.EQ.0) GO TO 29
  1029. C
  1030. C MODELE CHABOC MISE A JOUR DE SPHER DANS CHABOC
  1031. C SPHER CONTIENT LA SOMME DES DEPLACEMENTS DES SPHERES
  1032. C
  1033. IF(IMAPLA.EQ.4) GO TO 29
  1034. IF(LFLUAG.EQ.1.AND.JFLUAG.NE.0) GO TO 29
  1035. DO 34 IBA=1,IBOU
  1036. 34 SPHER(IBA)=SPHER(IBA)+DALPHA(IBA)
  1037. 29 CONTINUE
  1038. C-----------------------------------------------------------------------
  1039. C CALCUL DU SIGMA FINAL ET DE LA NOUVELLE LIMITE ELASTIQUE
  1040. C-----------------------------------------------------------------------
  1041. IF(ITYP.NE.11.AND.ITYP.NE.12.AND.ITYP.NE.4) GO TO 846
  1042. DO 847 IBA=1,IBOU
  1043. STOT(IBA)=STOT(IBA)/DIV(IBA)
  1044. IF(ICINE.EQ.0) GO TO 847
  1045. IF(LFLUAG.EQ.1.AND.JFLUAG.NE.0) GO TO 847
  1046. SPHER(IBA)=SPHER(IBA)/DIV(IBA)
  1047. DALPHA(IBA)=DALPHA(IBA)/DIV(IBA)
  1048. 847 SIGEL(IBA)=SIGEL(IBA)/DIV(IBA)
  1049. 846 DO 291 IBA=1,IBOU
  1050. 291 SIGFIN(IBA)=SIGEL(IBA)
  1051. STARF=SI
  1052. IF(JFLUAG.EQ.0) SLIMF=SN
  1053. IF(JNTRIN.NE.0) EPENTF=TIMEXF
  1054. C
  1055. IF(DEPS.LT.0.D00) KERRE=1
  1056. C CALCUL DU NOUVEAU SIGMAP
  1057. DO 24 IBA=1,IBOU
  1058. 24 DSIGMA(IBA)=STOT(IBA)-SIGEL(IBA)
  1059. IF(ICINE.EQ.0) GO TO 240
  1060. IF(JFLUAG.EQ.1) GO TO 240
  1061. IF(LFLUAG.EQ.1) GO TO 240
  1062. DO 241 IBA=1,IBOU
  1063. 241 DSIGMA(IBA)=DSIGMA(IBA)-DALPHA(IBA)
  1064. 240 CONTINUE
  1065. *
  1066. IF(ITYP.EQ.6.AND.IMAPLA.EQ.5.AND.LAPOIN.EQ.0) THEN
  1067. DO 322 IBA=1,IBOU
  1068. 322 DEFPLA(IBA)=EPSPLA(IBA)
  1069. EPST=EPSM1 + VONEPS(DEFPLA,ITYP,ALFAH,COVNMS)
  1070. GO TO 31
  1071. ENDIF
  1072. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  1073. C ATTENTION LE EPSIG NE MARCHE QUE POUR CERTAINS CAS
  1074. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  1075. CALL EPSIG(DSIGMA,DEFPLA,IFOURB,YUNG,XNU,ITYP,ORMAT,CARAC)
  1076. IF(ITYP.EQ.6.AND.IMAPLA.NE.5) DEFPLA(3)=-DEFPLA(1)-DEFPLA(2)
  1077. 31 CONTINUE
  1078. C-----------------------------------------------------------------------
  1079. C REMPLISSAGE
  1080. C-----------------------------------------------------------------------
  1081. VARINF(1)=EPST
  1082. CZZZZZZZZZZZ
  1083. C PROVISOIRE
  1084. CZZZZZZZZZZZ
  1085. IF(JFLUAG.EQ.1) VARINF(1)=EPSFLU
  1086. IF(ICINE.EQ.0) GO TO 280
  1087. C ON CALCULE LA VRAIE CONTRAINTE EN CINEMATIQUE
  1088. DO 281 IBA=1,IBOU
  1089. IF(JFLUAG.EQ.1) GO TO 284
  1090. SIGFIN(IBA)=SIGFIN(IBA)+SPHER(IBA)
  1091. 284 IF(LFLUAG.EQ.1) GO TO 281
  1092. IF(ICENT2.NE.0) SPHER(IBA)=SPHER(IBA)-AUXIL(IBA)
  1093. 281 CONTINUE
  1094. 280 CONTINUE
  1095. *
  1096. * MISE A 0. DES COMPOSANTES NON CALCULEES SI ITYP=8
  1097. *
  1098. IF(ITYP.EQ.8.AND.IBOU.LT.NSTRS) THEN
  1099. DO 285 IBA=2,NSTRS
  1100. DEFPLA(IBA)=0.D0
  1101. SIGFIN(IBA)=0.D0
  1102. IF(ICENT2.NE.0) SPHER(IBA)=0.D0
  1103. 285 CONTINUE
  1104. ENDIF
  1105. *
  1106. MCOD=2
  1107. iecou=0
  1108. inecou=0
  1109. CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL,
  1110. . SIGF,DEFP,VARINF,SIGFIN,DEFPLA,
  1111. . DSIGZE,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE,
  1112. . iecou,inecou)
  1113. C
  1114. C RETRAITEMENT POUR LES COQ2 ET MASSIFS EN MATERIAU
  1115. C UNIDIRECTIONNEL
  1116. C
  1117.  
  1118. IF (CMATE.EQ.'UNIDIREC'.AND.INPLAS.NE.0) THEN
  1119. IF(MELE.EQ.44.OR.(MFR.EQ.1.AND.IFOURB.LE.0)) THEN
  1120. DO 1997 I=1,NSTRS
  1121. TABID(I)=SIGF(I)
  1122. TABID2(I)=DEFP(I)
  1123. 1997 CONTINUE
  1124. CALL CHREP2(TABID,SIGF,-ANG,NSTRS,MFR,1,KERRE)
  1125. CALL CHREP2(TABID2,DEFP,-ANG,NSTRS,MFR,2,KERRE)
  1126. IF(KERRE.NE.0) RETURN
  1127. ELSEIF(MFR.EQ.1.AND.IFOURB.EQ.2) THEN
  1128. DO 997 I=1,NSTRS
  1129. TABID(I)=SIGF(I)
  1130. TABID2(I)=DEFP(I)
  1131. 997 CONTINUE
  1132. CALL CHREP3(TABID,SIGF,XMAT,TXR,NSTRS,1,2,KERRE)
  1133. CALL CHREP3(TABID2,DEFP,XMAT,TXR,NSTRS,2,2,KERRE)
  1134. ENDIF
  1135. ENDIF
  1136. *
  1137. 1000 RETURN
  1138. END
  1139.  
  1140.  
  1141.  
  1142.  
  1143.  
  1144.  
  1145.  
  1146.  
  1147.  
  1148.  
  1149.  
  1150.  
  1151.  
  1152.  

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