Télécharger ccoinc.eso

Retour à la liste

Numérotation des lignes :

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

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