Télécharger cflun2.eso

Retour à la liste

Numérotation des lignes :

  1. C CFLUN2 SOURCE BP208322 17/03/01 21:15:33 9325
  2. SUBROUTINE CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,
  3. & IB,IGAU,NBPGAU,NBGMAT,NELMAT,IFOURB)
  4. *
  5. * modele fluage type Norton dep/dt = C sig^n t^m
  6. * traite sigf = sig0 + k (deps - dep)
  7. * on pourrait separer deviateur et terme spherique
  8. *
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8 (A-H,O-Z)
  11. -INC CCOPTIO
  12. -INC DECHE
  13. -INC SMLREEL
  14. -INC SMEVOLL
  15. *
  16. *
  17. *
  18. SEGMENT WRK2
  19. REAL*8 TRAC(LTRAC)
  20. ENDSEGMENT
  21. *
  22. SEGMENT WRK3
  23. REAL*8 WORK(LW),WORK2(LW2)
  24. ENDSEGMENT
  25. *
  26. dimension spri0(8),delep0(8),spri1(8),delep1(8),
  27. &DIV(8)
  28.  
  29.  
  30.  
  31. * cas isotrope
  32. ip1 = 4
  33. *
  34. youn0 = xmat0(1)
  35. sigy0 = xmat0(ip1+1)
  36. xc0 = xmat0(ip1+2)
  37. xn0 = xmat0(ip1+3)
  38. xm0 = xmat0(ip1+4)
  39. ips0 = int(xmat0(ip1+5))
  40. ipe0 = int(xmat0(ip1+6))
  41. x2mu0= xmat0(1)/(1.+xmat0(2))
  42.  
  43.  
  44. if(ib.eq.1.and.igau.eq.1) then
  45. * write(6,*) 't0' , youn0, sigy0, xn0 ,xm0 ,gk0,pk0
  46. endif
  47.  
  48. youn1 = xmat(1)
  49. sigy1 = xmat(ip1+1)
  50. xc1 = xmat(ip1+2)
  51. xn1 = xmat(ip1+3)
  52. xm1 = xmat(ip1+4)
  53. ips1 = int(xmat(ip1+5))
  54. ipe1 = int(xmat(ip1+6))
  55. x2mu1= xmat(1)/(1.+xmat(2))
  56.  
  57. if(ib.eq.1.and.igau.eq.1) then
  58. * write(6,*) 't1' ,ips1,ipe1
  59. endif
  60. *
  61. delt = tempf - temp0
  62. if (delt.lt.0..or.tempf.lt.0.) then
  63. moterr(1:16) = conm
  64. moterr(17:24) = 'CFLUN2-5'
  65. call erreur(943)
  66. return
  67. endif
  68.  
  69. C---------CARACTERISTIQUES GEOMETRIQUES---------------------------------
  70. C
  71. C COQUES
  72. C
  73. ALFAH=1.D0
  74. IF(MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  75. EP1=work(1)
  76. IF(MFR.NE.5) ALFAH=work(2)**2
  77. ENDIF
  78. C---------COQUES AVEC CT------------------------------------------------
  79. C ON NE TRAVAILLE QUE SUR LES 6 PREMIERES COMPOSANTES
  80.  
  81. IF(MFR.EQ.9) THEN
  82. NCONT=6
  83. ELSE
  84. NCONT=NSTRS
  85. ENDIF
  86.  
  87. * calcul increments de contrainte
  88. * remarque on utilise les caracteristiques elastiques a la date finale
  89.  
  90. CALL CALSIG(depst,DDAUX,NSTAUX,CMATE,VALMAT,VALCAR,
  91. & N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST,
  92. & NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  93. & XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,dsigt,IRTD)
  94.  
  95. IF(IRTD.NE.1) THEN
  96. KERRE=69
  97. GOTO 1010
  98. ENDIF
  99.  
  100. * determine direction et sens de sigf et eflu
  101.  
  102. DO I=1,NSTRS
  103. DSIGT(I)=SIG0(I) + dsigt(i)
  104. ENDDO
  105.  
  106. C---------CAS DES POUTRES-----------------------------------------------
  107.  
  108. IF(MFR.EQ.7) THEN
  109. DIV(1)=1.D0/work(4)
  110. DIV(2)=1.D0
  111. DIV(3)=1.D0
  112. DIV(4)=work(10)/work(1)
  113. DIV(5)=work(11)/work(2)
  114. DIV(6)=work(12)/work(3)
  115. IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(work(1)*work(4))
  116. IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(work(2)*work(4))
  117. IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(work(3)*work(4))
  118. DO I=1,NCONT
  119. DSIGT(I)= DSIGT(I)*DIV(I)
  120. ENDDO
  121. ENDIF
  122. *
  123. * raisonne en deviateur
  124. trsig0 = (dsigt(1) + dsigt(2) + dsigt(3)) * 0.33333333333d0
  125. spri0(1) = dsigt(1) - trsig0
  126. spri0(2) = dsigt(2) - trsig0
  127. spri0(3) = dsigt(3) - trsig0
  128. do is = 4,nstrs
  129. spri0(is) = dsigt(is)
  130. enddo
  131.  
  132. C-----------------------------------------------------------------------
  133. C CALCUL DE LA CONTRAINTE EQUIVALENTE SEQ
  134. C-----------------------------------------------------------------------
  135. seqtot=VONMIS0(spri0,NSTRS,MFR,IFOURB,EP1,ALFAH)
  136.  
  137. if (seqtot - sigy1.gt.0.) then
  138. seq0 = seqtot
  139. else
  140. * pas de termes inelastiques
  141. do ic = 1,nstrs
  142. sigf(ic) = dsigt(ic)
  143. enddo
  144. varf(1) = var0(1)
  145. varf(2) = var0(2)
  146. goto 1002
  147. return
  148. endif
  149.  
  150. if (xn1.ge.0..and.xc1.ge.0..and.xm1.ge.0..AND.x2mu1.ge.0.) then
  151. else
  152. moterr(1:16) = conm
  153. moterr(17:24) = 'CFLUEN-1'
  154. c write(6,*) xn1,xc1,xm1,x2mu1
  155. call erreur(943)
  156. return
  157. endif
  158.  
  159. * point fixe pour determiner le multiplicateur de sigtot/seqtot
  160. icaz = 1
  161. do ipfx = 1,50
  162. if(ib.eq.1.and.igau.eq.1) then
  163. c write(6,*) 'pt fixe' , ipfx, seq0,seqtot,icaz
  164. endif
  165. goto (70,80) icaz
  166. 70 continue
  167. * fonction
  168. delr0 = (seq0 ** xn1) * (tempf ** xm1)
  169. xmult = delr0 * xc1 * delt * x2mu1
  170. seq01 = seqtot - xmult
  171. goto 90
  172.  
  173. * fonction associee
  174. 80 continue
  175. xmult = seqtot - seq0
  176. delr0 = xmult / delt/xc1 / (tempf ** xm1) / x2mu1
  177. seq01 = delr0 ** (1/xn1)
  178. goto 90
  179.  
  180. 90 continue
  181. if(ib.eq.1.and.igau.eq.1) then
  182. * write(6,*) 'delr0' , delr0,xmult,seq01, icaz
  183. endif
  184. if (ipfx.eq.1) then
  185. if (seq01.lt.0) then
  186. icaz = 2
  187. seq01 = seqtot/2.
  188. else if (seq01.eq.0.) then
  189. icaz =1
  190. seq01 = seqtot/2.
  191. endif
  192. endif
  193. varseq = abs((seq01 - seq0) / seq0)
  194. if (ib.eq.1.and.igau.eq.1) then
  195. c write(6,*) 'variation relative', varseq
  196. endif
  197. seq0 = seq01
  198. if (seq0 .lt.0.) then
  199. c write(6,*) 'erreur point fixe', seqtot, seq0
  200. moterr(1:16) = conm
  201. moterr(17:24) = 'CFLUN2-6'
  202. call erreur(943)
  203. return
  204. endif
  205. if (varseq.lt.1.e-6) goto 100
  206.  
  207. enddo
  208.  
  209. 100 if (seqtot - seq0 .lt.0.) then
  210. c write(6,*) 'erreur point fixe', seqtot, seq0
  211. moterr(1:16) = conm
  212. moterr(17:24) = 'CFLUN2-7'
  213. call erreur(943)
  214. return
  215. endif
  216.  
  217. c au final
  218. 1000 continue
  219. do ic = 1,nstrs
  220. sigf(ic) = dsigt(ic) * seq0 / seqtot
  221. enddo
  222.  
  223.  
  224. varf(1) = var0(1) + xc1*(seq0**xn1)*(tempf**xm1)*delt
  225. varf(2) = var0(2)
  226.  
  227. * position vis a vis des abaques
  228. if (ips1.gt.0) then
  229. temcri =0.d0
  230.  
  231. mevoll = ips1
  232. segact mevoll
  233. kevoll = ievoll(1)
  234. segact kevoll
  235. mlree1 = iprogx
  236. mlree2 = iprogy
  237. segact mlree1,mlree2
  238. nds = mlree2.prog(/1)
  239. * suppose valeurs de contraintes decroissantes et temps croissants
  240. do jds=1,nds-1
  241. if (mlree2.prog(jds).le.mlree2.prog(jds+1).or.
  242. &mlree1.prog(jds).ge.mlree1.prog(jds+1)) then
  243. moterr(1:16) = conm
  244. moterr(17:24) = 'CFLUN2-8'
  245. call erreur(943)
  246. return
  247. endif
  248. if(mlree2.prog(jds).ge.seq0.and.seq0.gt.mlree2.prog(jds+1))then
  249. tosig = (mlree2.prog(jds) - seq0)/
  250. & (mlree2.prog(jds) - mlree2.prog(jds+1))
  251. * interpole logarithmiquement
  252. utemp = tosig * (log(mlree1.prog(jds+1))
  253. & - log(mlree1.prog(jds))) + log(mlree1.prog(jds))
  254. temcri = exp(utemp)
  255. *
  256. goto 1001
  257. endif
  258. enddo
  259.  
  260. 1001 if (temcri.gt.0) then
  261. varf(2) = var0(2) + delt/temcri
  262. if (varf(2).gt.1) then
  263. write(6,*) 'detruire prochaine etape', ipmail, conm,ib,igau
  264. endif
  265. endif
  266. endif
  267.  
  268. 1002 continue
  269. if(ib.eq.1.and.igau.eq.1) then
  270. c write(6,*) 't0' ,sigf(3),varf(1),varf(2),depst(3),dsigt(3)
  271. endif
  272.  
  273. 1010 continue
  274. RETURN
  275. END
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  

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