Télécharger ccoinc.eso

Retour à la liste

Numérotation des lignes :

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

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