Télécharger ctufpl.eso

Retour à la liste

Numérotation des lignes :

  1. C CTUFPL SOURCE BP208322 17/03/01 21:16:46 9325
  2. SUBROUTINE CTUFPL(WRK52,WRK53,WRK54,WRK2,
  3. 1 IFOU,IB,IGAU,NBPGAU,iecou)
  4. C TUFPLA SOURCE KICH 98/07/01 00:32:42 3239
  5. c SUBROUTINE TUFPLA(WRK1,WRK0,WRK2,WTRAV,MAPL,PRECIS,
  6. c 1 NSTRS,CMATE,N2EL,N2PTEL,MFR,IFOU,IB,
  7. c 2 IGAU,EPAIST,MELE,NPINT,NBGMAT,NELMAT,
  8. c 3 NBPGAU,SECT,LHOOK,CRIGI,KERRE)
  9. *
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. C----------------------------------------------------------------------
  13. C PLASTICITE TUYAU FISSURE
  14. C CE SOUS PROGRAMME EST APPELE PAR PLAST
  15. C
  16. C ENTREES
  17. C SIG0(NSTRS1) = CONTRAINTES INITIALES
  18. C NSTRS1 = NOMBRE DE CONTRAINTES
  19. C DEPST(NSTRS1)= INCREMENT DE CONTRAINTES TOTALES
  20. C VAR0(NVARI) = VARIABLES INTERNES DEBUT
  21. C NVARI = NOMBRE DE VARIABLES INTERNES
  22. C XMAT(NCXMAT)= COMPOSANTES DE MATERIAU
  23. C NCOMAT = NOMBRE DE COMPOSANTES DE MATERIAU
  24. C xcarb(ICARA) = CARACTERISTIQUES
  25. C ICARA = NOMBRE DE CARACTERISTIQUES
  26. C MAPL = NUMERO DU MATERIAU PLASTIQUE
  27. C NPOITR = NOMBRE DE POINT SUR LA COURBE DE TRACTION
  28. C PRECIS = PRECISION DES ITERATIONS
  29. * CMATE = NOM DU MATERIAU
  30. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  31. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  32. * MFR1 = NUMERO DE LA FORMULATION
  33. * IFOU = OPTION DE CALCUL
  34. * IB = NUMERO DE L ELEMENT COURANT
  35. * IGAU = NUMERO DU POINT COURANT
  36. * EPAIST= EPAISSEUR
  37. * NBPGAU= NBRE DE POINTS DE GAUSS
  38. * MELE = NUMERO DE L ELEMENT FINI
  39. * NPINT = NBRE DE POINTS D INTEGRATION
  40. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  41. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  42. * SECT = SECTION
  43. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  44. *
  45. C SORTIES
  46. C SIGF(NSTRS1) = CONTRAINTES FINALES
  47. C VARF(NVARI) = VARIABLES INTERNES FINALES
  48. C DEFP(NSTRS1) = DEFORMATIONS PLASTIQUES
  49. C KERRE = 0 TOUT OK
  50. C 1 SI DLAMBDA NEGATIF
  51. C 2 NOMBRE MAX D ITERATIONS INTERNES DEPASSE
  52. C 21 ON NE TROUVE PAS L INTERSECTION AVEC LA SRFCE DE CHRG
  53. C 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE
  54. C 30 LIMITE ELASTIQUE NULLE
  55. C 34 MODULE D YOUNG NUL
  56. C 75 SORTIE DE LA COURBE DE TRACTION
  57. C-----------------------------------------------------------------------
  58. -INC CCREEL
  59. *-
  60. -INC CCOPTIO
  61. -INC SMEVOLL
  62. -INC SMLREEL
  63. -INC DECHE
  64. SEGMENT IECOU
  65. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  66. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  67. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  68. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  69. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  70. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  71. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  72. 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31,
  73. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  74. 4 icow32,icow33,NSTRS1,MFR1,NBGMAT,NELMAT,icow38,
  75. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  76. 5 icow39,icow40,icow41,icow42,icow43,icow44
  77. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  78. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  79. . icow51,icow52,icow53,icow54,icow55,icow56
  80. . icow57,icow58
  81. ENDSEGMENT
  82. SEGMENT/WRK2/(TRAC(LTRAC)*D)
  83. SEGMENT/WORK/(SIG(NCOURB)*D,XLAM(NCOURB)*D)
  84. DIMENSION DTUFI(2,2),CTUFI(2,2),CRIGI(12)
  85. C
  86. MAPL = INPLAS
  87. KERRE=0
  88. NSTRS1=SIG0(/1)
  89. NVARI=VAR0(/1)
  90. C
  91. C ON RECUPERE LES CONSTANTES
  92. C
  93. EPAI=xcarb(2)
  94. RAYOM=xcarb(1)-EPAI/2.D0
  95. THETA0=xcarb(9)*XPI/360.D0
  96. C
  97. C A PARTIR DE LA COURBE DE TRACTION , ON CONSTRUIT (SIG0,PHIP)
  98. C
  99. YOUN=XMAT(1)
  100. JDA=nint(XMAT(6))
  101. IF(MAPL.EQ.14) THEN
  102. CCC CAS DE LA PLASTICITE PARFAITE
  103. IF(XMAT(5).EQ.XZERO) THEN
  104. KERRE=30
  105. RETURN
  106. ENDIF
  107. NCOURB=2
  108. TRAC(1)=XMAT(5)
  109. TRAC(2)=XZERO
  110. TRAC(3)=XMAT(5)
  111. TRAC(4)=1.D0
  112. ELSE
  113. IF(MAPL.EQ.18) THEN
  114. CCC CAS DE LA PLASTICITE AVEC ECROUISSAGE
  115. C
  116. C ON CALCULE LA COMPLAISANCE CMM ET ON REMPLIT XMAT(1)=CMM POUR VERIF
  117. C PENTE A L ORIGINE DE LA COURBE (M,PHI)
  118. C
  119. CALL TUFIHO(THETA0,DTUFI,CTUFI,YOUN,RAYOM,EPAI)
  120. CMM=CTUFI(1,1)
  121. XMAT(1)=1.D0/CMM
  122. c CALL COTRAC(WRK0,WRK2,NCOURB,KERRE)
  123. call CCOTRA(WRK52,WRK2,NCOURB,WRK53)
  124. IF(KERRE.NE.0) RETURN
  125. ENDIF
  126. XMAT(1)=YOUN
  127. PMOMM=TRAC(2*NCOURB-1)
  128. IF(PMOMM.EQ.0.D0) THEN
  129. KERRE=30
  130. RETURN
  131. ENDIF
  132. C
  133. C ON CALCULE SIG0 POUR LE MOMENT MAXI
  134. C
  135. XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  136. XMT0=COS(THETA0/2.D0)-0.5D0*SIN(THETA0)
  137. VSIG0=PMOMM/XM0SS0/XMT0
  138. DO 100 I=1,NCOURB
  139. TRAC(2*I-1)=(TRAC(2*I-1)/PMOMM)*VSIG0
  140. 100 CONTINUE
  141. ENDIF
  142. C
  143. C REMPLISSAGE DE LA COURBE DE (SIG0,PHIP)
  144. C
  145. SEGINI WORK
  146. DO 2 I=1,NCOURB
  147. SIG(I)=TRAC(2*I-1)
  148. XLAM(I)=TRAC(2*I)
  149. 2 CONTINUE
  150. C
  151. C ON RECUPERE LES VARIABLES INTERNES
  152. C
  153. XM0SS0=4.D0*RAYOM*RAYOM*EPAI
  154. XP0SS0=2.D0*XPI*RAYOM*EPAI
  155. XJ1C=XMAT(6)
  156. T=XMAT(7)
  157. XLAM0=VAR0(5)
  158. THETA=VAR0(3)*XPI/360.D0
  159. XJP=VAR0(4)
  160. C CORRECTION DE L INITIALISATION FAITE PAR L OPERATEUR ZERO
  161. IF (THETA.LT.THETA0) THETA=THETA0
  162. C
  163. C CALCUL DE L INCREMENT DE CONTRAINTES
  164. C
  165. nstrbi=nstrs1
  166. mfr1bi=mfr1
  167. nbgmab=nbgmat
  168. nlmatb=nelmat
  169. CALL CALSIG(DEPST,DDAUX,NSTRbi,CMATE,VALMAT,VALCAR,
  170. 1 N2EL,N2PTEL,MFR1bi,IFOU,IB,IGAU,EPAIST,NBPGAU,
  171. 2 MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,
  172. 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  173. nstrs1=nstrbi
  174. mfr1=mfr1bi
  175. nbgmat=nbgmab
  176. nelmat=nlmatb
  177. *
  178. IF(IRTD.NE.1) THEN
  179. KERRE=69
  180. GOTO 998
  181. ENDIF
  182. *
  183. C
  184. C ON RECUPERE LES CONTRAINTES ET L INCREMENT
  185. C
  186. XM=-SIG0(6)
  187. XP=SIG0(1)
  188. CCC POUR LE CHARGEMENT M N , ON VERIFIE QUE L ON EST BIEN DANS
  189. C LA SURFACE DE CHARGE
  190. CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM
  191. CRI=CRI+XM0SS0*SIN(THETA0)*XP
  192. IBI=0
  193. CALL TRACTI(SIGMA0,XLAM0,SIG,XLAM,NCOURB,2,IBI)
  194. IF(IBI.EQ.1) THEN
  195. KERRE=75
  196. GO TO 998
  197. ENDIF
  198. XM0=XM0SS0*SIGMA0
  199. XP0=XP0SS0*SIGMA0
  200. F=CRIT1(XM,XP,THETA0,XM0,XP0)
  201. IF(F.GE.PRECIS) THEN
  202. KERRE=22
  203. GO TO 998
  204. ENDIF
  205. DELTAM=-DSIGT(6)
  206. DELTAP=DSIGT(1)
  207. C
  208. C ON REMPLIT POUR LE CAS ELASTIQUE
  209. C
  210. DO 10 I=1,NSTRS1
  211. SIGF(I)=SIG0(I)+DSIGT(I)
  212. DEFP(I)=0.D0
  213. DSIGT(I)=0.D0
  214. 10 CONTINUE
  215. DO 11 J=1,NVARI
  216. VARF(J)=VAR0(J)
  217. 11 CONTINUE
  218. C
  219. C ON TESTE LE CAS A TRAITER
  220. C
  221. 1 CONTINUE
  222. XM1=XM+DELTAM
  223. XP1=XP+DELTAP
  224. CRI=2.D0*XP0SS0*(1.D0-THETA0/XPI)*XM1
  225. CRI=CRI+XM0SS0*SIN(THETA0)*XP1
  226. CALL TUFIJE(XM1,XP1,THETA0,XJE,RAYOM,EPAI,YOUN)
  227. CALL TUFIC1(XM1,XP1,THETA0,IR1,PRECIS,XM0,XP0)
  228. IF (MAPL.EQ.14) THEN
  229. C
  230. C DANS LE CAS DE LA PLASTICITE PARFAITE ON NE FAIT QUE DE LA PLASTICITE
  231. C
  232. CALL TUFIC2(XJP,XJE,THETA,IR2,PRECIS,XJ1C,T,RAYOM,THETA0)
  233. ELSE
  234. IF (MAPL.EQ.18) THEN
  235. IR2=0
  236. ENDIF
  237. ENDIF
  238. IF(IIMPI.EQ.999)THEN
  239. IF(IR1.EQ.1)WRITE(IOIMP,*)'PLASTICITE'
  240. IF(IR2.EQ.1)WRITE(IOIMP,*)'ENDOMMAGEMENT'
  241. IF((IR1.EQ.0).AND.(IR2.EQ.0))WRITE(IOIMP,*)'NI PLAST NI ENDO'
  242. ENDIF
  243. C
  244. IF((IR1.EQ.0).AND.(IR2.EQ.0)) GO TO 998
  245. IF((IR1.EQ.0).AND.(IR2.EQ.1)) GO TO 2000
  246. IF((IR1.EQ.1).AND.(IR2.EQ.0)) GO TO 3000
  247. IF((IR1.EQ.1).AND.(IR2.EQ.1)) GO TO 4000
  248. C
  249. C CAS DE LA PROPAGATION EN ELASTIQUE
  250. C
  251. 2000 CONTINUE
  252. CALL TUFIEN(XM,XP,DELTAM,DELTAP,THETA,XJP,PRECIS,THETA0,XM0,
  253. & XP0,XJ1C,T,RAYOM,EPAI,YOUN)
  254. IF(KERRE.NE.0) GO TO 998
  255. SIGF(6)=-XM
  256. SIGF(1)=XP
  257. VARF(3)=THETA*360.D0/XPI
  258. IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998
  259. GO TO 1
  260. C
  261. C CAS DE LA PLASTICITE AVEC PROPAGATION
  262. C
  263. 3000 CONTINUE
  264. C
  265. C ON CHERCHE L INTERSECTION AVEC LA SURFACE DE CHARGE
  266. C
  267. VER=F
  268. IF(IIMPI.EQ.999)WRITE (IOIMP,*) 'VERIF AVANT APPEL A TUFICO',VER
  269. PRECUS=-PRECIS
  270. IF(VER.LE.PRECUS) THEN
  271. CALL TUFICO(XM,XP,DELTAM,DELTAP,THETA0,XM0,XP0)
  272. IF(IIMPI.EQ.999)THEN
  273. VER=F
  274. WRITE (IOIMP,*)'ON EST SUR LE CRITERE',VER
  275. ENDIF
  276. ENDIF
  277. C
  278. C ON REALISE L ECOULEMENT
  279. C
  280. CALL TUFIPL(XM,XP,DELTAM,DELTAP,THETA,XJP,DLAM1,DLAM2,EP,FIP,
  281. $ PRECIS,XM0,XP0,RAYOM,XLAM0,WORK,XJ1C,T,THETA0,EPAI,YOUN,KERRE
  282. $ ,MAPL)
  283. IF(KERRE.NE.0) GO TO 998
  284. C
  285. IF(IIMPI.EQ.999)THEN
  286. VER=CRIT1(XM,XP,THETA0,XM0,XP0)
  287. WRITE (IOIMP,*) 'VERIF APRES ECOULEMENT',VER
  288. ENDIF
  289. CALL TUFK1A(XM,XP,YOUN,RAYOM,EPAI,THETA0,XK1,AIRE)
  290. IF (MAPL.EQ.18) THEN
  291. C
  292. CDANS LE CAS DE LA PLASTICITE AVEC ECROUISSAGE ON FAIT DE LA PROPAGATION
  293. C
  294. CALL TUFJDA(THETA,XJP,RAYOM,JDA,THETA0,XK1,YOUN,KERRE2)
  295. KERRE = KERRE2
  296. IF(KERRE.NE.0) GO TO 998
  297. ENDIF
  298. SIGF(6)=-XM
  299. SIGF(1)=XP
  300. SIGF(7)=XK1
  301. SIGF(8)=AIRE
  302. DEFP(6)=DEFP(6)-FIP
  303. DEFP(1)=DEFP(1)+EP
  304. VARF(1)=VARF(1)+DLAM1
  305. VARF(2)=VARF(2)+DLAM2
  306. VARF(3)=(THETA*360.D0)/XPI
  307. VARF(4)=XJP
  308. VARF(5)=VARF(5)+DLAM1+DLAM2
  309. C IF((DELTAM.EQ.XZERO).AND.(DELTAP.EQ.XZERO)) GO TO 998
  310. C GO TO 1
  311. C
  312. C CAS DU COUPLAGE PLASTICITE PROPAGATION
  313. C
  314. 4000 GO TO 998
  315. 998 CONTINUE
  316. SEGSUP WORK
  317. RETURN
  318. END
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  

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