Télécharger cflun2.eso

Retour à la liste

Numérotation des lignes :

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

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