Télécharger fatig2.eso

Retour à la liste

Numérotation des lignes :

  1. C FATIG2 SOURCE KICH 19/10/28 21:15:00 10358
  2. SUBROUTINE FATIG2(ITCONT,ITTEMP,IPMODE,IPCAR,ICF1,xre1,xre2,
  3. &ICLE,NCLE,CLE,ICHOUT)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC CCOPTIO
  7. -INC SMMODEL
  8. -INC SMCHAML
  9. -INC SMELEME
  10. -INC SMEVOLL
  11. -INC SMLREEL
  12. SEGMENT,MLCARF
  13. integer lcarfa(NCF,N1)
  14. ENDSEGMENT
  15. SEGMENT,MCYSIG
  16. integer lcysig(nbrobl,ncycl)
  17. real*8 sigcyc(nbrobl,ncycl),pcyc(ncycl)
  18. ENDSEGMENT
  19. SEGMENT,MRECYC
  20. real*8 ycyc(ncycl)
  21. ENDSEGMENT
  22. SEGMENT,MDEVCY
  23. real*8 sdcyc(nbrobl-1,ncycl)
  24. ENDSEGMENT
  25. SEGMENT,MDEVSI
  26. real*8 sd(nbrobl)
  27. ENDSEGMENT
  28. LOGICAL LOG0,LOG1,lC4,lC5,lC3,lC6
  29. CHARACTER*4 COFA(4),CLE(NCLE)
  30. DATA COFA/'AA','BB','CC','DD'/
  31. DATA zecrit/-2.d-1/
  32.  
  33.  
  34.  
  35. SQ2 = dsqrt(2.d0)
  36. SQ3S2 = dsqrt(1.5D0)
  37. SQ3 = dsqrt(3.d0)
  38.  
  39.  
  40. mmodel = ipmode
  41. segact mmodel
  42. n1 = kmodel(/1)
  43. n2 = 0
  44. l1 = 16
  45. n3 = 6
  46. segini mchel2
  47. mchel2.titche(1:8) = 'FATIGUE '
  48. if (ICF1.gt.0) then
  49. mchel1= ICF1
  50. segact mchel1
  51. * mchel2.titche(9:16) = mchel1.titche(9:16)
  52. endif
  53. ncf = 2
  54. segini mlcarf
  55.  
  56. if(icle.eq.2.or.icle.eq.3) then
  57. n=0
  58. segini mevoll
  59. IEVTEX = 'EVOLUTION VIDE'
  60. mevnul = mevoll
  61. segdes mevoll
  62. endif
  63.  
  64.  
  65.  
  66. do ik = 1,n1
  67. imodel = kmodel(ik)
  68. segact imodel
  69. mchel2.conche(ik) = conmod
  70. mchel2.imache(ik) = imamod
  71. mchel2.ifoche = ifour
  72. mchel2.infche(ik,4) = infmod(7)
  73. mchel2.infche(ik,6) = 5
  74.  
  75. if(ICF1.gt.0) then
  76. do ic = 1,mchel1.imache(/1)
  77. if (mchel1.imache(ic).eq.imamod) then
  78. mchaml = mchel1.ichaml(ic)
  79. segact mchaml
  80. n2 = nomche(/2)
  81. do inom = 1,n2
  82. * controler les noms des caracteristiques du critere
  83. melval = ielval(inom)
  84. if(icle.le.6) then
  85. if(nomche(inom)(1:2).eq.cofa(1)(1:2)) then
  86. segact melval
  87. lcarfa(1,ik) = melval
  88. endif
  89. if(nomche(inom)(1:2).eq.cofa(2)(1:2)) then
  90. segact melval
  91. lcarfa(2,ik) = melval
  92. endif
  93. endif
  94.  
  95. enddo
  96. segdes mchaml
  97. endif
  98. enddo
  99. endif
  100.  
  101. * sorties
  102. if(icle.eq.1) then
  103. n2 = ncle - 1
  104. elseif(icle.gt.1) then
  105. n2 = 1
  106. endif
  107. segini mchaml
  108. mchel2.ichaml(ik) = mchaml
  109. meleme = imamod
  110. segact meleme
  111. nbelem = num(/2)
  112. nbgs = infele(4)
  113. n1ptel= nbgs
  114. n1el = nbelem
  115. n2ptel = 0
  116. n2el = 0
  117. if(icle.eq.1) then
  118. do je = 1,n2
  119. segini melval
  120. ielval(je) = melval
  121. nomche(je) = cle(je+1)
  122. typche(je) = 'REAL*8'
  123. enddo
  124. elseif(icle.gt.1) then
  125. segini melval
  126. ielval(1) = melval
  127. nomche(1) = cle(icle)
  128. typche(1) = 'REAL*8'
  129. endif
  130.  
  131. if(icle.eq.2.or.icle.eq.3) then
  132. n2 = 2
  133. segadj mchaml
  134. n2ptel = nbgs
  135. n2el = nbelem
  136. n1ptel = 0
  137. n1el = 0
  138. segini melval
  139. ielval(2) = melval
  140. nomche(2) = 'TRAJ'
  141. typche(2) = 'POINTEUREVOLUTIO'
  142. segini kevoll
  143. ielche(1,1) = kevoll
  144. kevdvk = kevoll
  145. jg = 2
  146. segini mlreel
  147. iprogx = mlreel
  148. segini mlreel
  149. iprogy = mlreel
  150. NUMEVX = 4
  151. NUMEVY='REEL'
  152. NOMEVX = 'P'
  153. NOMEVY = 'TAU'
  154. TYPX = 'LISTREEL'
  155. TYPY = 'LISTREEL'
  156. endif
  157.  
  158. enddo
  159.  
  160. mtable = ITCONT
  161. mtab1 = ittemp
  162.  
  163. i0 = 0
  164. X0 = 0.D0
  165. LOG0 = .TRUE.
  166. ip0 = 0
  167. I1 = 0
  168. x1 = 0.d0
  169. LOG1 = .TRUE.
  170. IP1 = 0
  171.  
  172. CALL DIMEN7 (ittemp,ntemps)
  173. do jr =1,2
  174. if(jr.eq.1) xreu = xre1
  175. if(jr.eq.2) xreu = xre2
  176. * presuppose indice 0 t=0.
  177. if(xreu.eq.0.d0) then
  178. intc = 0
  179. elseif(xreu.gt.0.d0) then
  180. xd1 = xreu
  181. do ind1 = 1,ntemps
  182. I0 = ind1 - 1
  183. CALL ACCTAB(ITTEMP,'ENTIER',I0,X0,' ',LOG0,IP0,
  184. & 'FLOTTANT',I1,X1,' ',LOG1,IP1)
  185. if (ierr.ne.0) return
  186. xu = xreu - x1
  187. if (xu.gt.0.d0.and.xu.le.xd1) then
  188. xd1 = xu
  189. else if (dabs(xu).le.xd1) then
  190. goto 14
  191. else
  192. I0 = I0 - 1
  193. goto 14
  194. endif
  195. enddo
  196. 14 continue
  197. intc = I0
  198. endif
  199.  
  200. if(jr.eq.1) i0temd = intc
  201. if(jr.eq.2) then
  202. if(xre2.gt.0) then
  203. i0temf = intc
  204. else
  205. i0temf = ntemps -1
  206. endif
  207. endif
  208. enddo
  209.  
  210. DO ik = 1,kmodel(/1)
  211. isk = 0
  212. imodel = kmodel(ik)
  213. * caracteristiques critere
  214. if(icle.le.6) then
  215. melva1 = lcarfa(1,ik)
  216. melva2 = lcarfa(2,ik)
  217. endif
  218. * sorties
  219. mcham2 = mchel2.ichaml(ik)
  220. nomid = lnomid(4)
  221. segact nomid
  222. nbrobl = lesobl(/2)
  223. segini mdevsi
  224. if(icle.gt.3) then
  225. ncycl = 0
  226. segini mrecyc
  227. endif
  228.  
  229. ncycl = i0temf - i0temd + 1
  230. segini mcysig
  231. segini MDEVCY
  232. if (icle.le.3) segini mrecyc
  233.  
  234. ktem = 0
  235. DO I0 = i0temd,i0temf
  236. ktem = ktem + 1
  237. CALL ACCTAB(ITCONT,'ENTIER',I0,X0,' ',LOG0,IP0,
  238. & 'MCHAML ',I1,X1,' ',LOG1,IP1)
  239. MCHELM = ip1
  240. SEGACT MCHELM
  241.  
  242. do is = 1,imache(/1)
  243. if(imamod.eq.imache(is)) isk = is
  244. enddo
  245. if (isk.eq.0) then
  246. call erreur(5)
  247. return
  248. endif
  249. mchaml = ichaml(isk)
  250. segact mchaml
  251. * controle des composantes de contraintes
  252. n2 = nomche(/2)
  253. * on travaille a priori avec les composantes obligatoires
  254. do iobl = 1, nbrobl
  255. do imch = 1,nomche(/2)
  256. if(lesobl(iobl).eq.nomche(imch)) then
  257. lcysig(iobl,ktem) = ielval(imch)
  258. melval = ielval(imch)
  259. segact melval
  260. endif
  261. enddo
  262. enddo
  263.  
  264. segdes mchaml
  265. SEGDES MCHELM
  266. ENDDO
  267.  
  268.  
  269. meleme = imamod
  270. nbelem = num(/2)
  271. nbgs = infele(4)
  272. nstrs = infele(16)
  273. mfr = infele(13)
  274. DO ib = 1,nbelem
  275. do igau = 1,nbgs
  276. IGMN=MIN(IGAU,melva1.VELCHE(/1))
  277. IBMN=MIN(IB ,melva1.VELCHE(/2))
  278. cofa1 = melva1.velche(igmn,ibmn)*(-1)
  279.  
  280. IGMN=MIN(IGAU,melva2.VELCHE(/1))
  281. IBMN=MIN(IB ,melva2.VELCHE(/2))
  282. cofa2 = melva2.velche(igmn,ibmn)
  283.  
  284. DO icyc = 1,ncycl
  285. do iobl = 1,nbrobl
  286. MELVAL = lcysig(iobl,icyc)
  287. if (melval.gt.0) then
  288. IGMN=MIN(IGAU,VELCHE(/1))
  289. IBMN=MIN(IB ,VELCHE(/2))
  290. sd(iobl)=VELCHE(IGMN,IBMN)
  291. sigcyc(iobl,icyc) = VELCHE(IGMN,IBMN)
  292. else
  293. sd(iobl) = 0.d0
  294. sigcyc(iobl,icyc) = 0.d0
  295. endif
  296. enddo
  297.  
  298. PCYC(ICYC) = (SIGCYC(1,ICYC)+SIGCYC(2,ICYC)+SIGCYC(3,ICYC))/3
  299. if(ib.eq.1.and.igau.eq.1.and.icyc.eq.1) then
  300. pcymax = pcyc(1)
  301. pcymin = pcyc(1)
  302. else
  303. pcymax = max(pcymax,pcyc(icyc))
  304. pcymin = min(pcymin,pcyc(icyc))
  305. endif
  306. SDCYC(1,icyc) = (SIGCYC(1,icyc)-SIGCYC(2,icyc))/SQ2
  307. SDCYC(2,icyc)=(SIGCYC(1,icyc)+SIGCYC(2,icyc)-2.*PCYC(icyc))*SQ3S2
  308. SDCYC(3,icyc) = SIGCYC(4,icyc)
  309. if(nbrobl.gt.4) then
  310. SDCYC(4,icyc) = SIGCYC(5,icyc)
  311. SDCYC(5,icyc) = SIGCYC(6,icyc)
  312. endif
  313.  
  314. * boucle icyc
  315. ENDDO
  316.  
  317. if(nbrobl.le.1) then
  318. * write(6,*) 'DVPA2, manquent composantes contraintes'
  319. interr(1) = imodel
  320. interr(2) = imamod
  321. call erreur(973)
  322. return
  323. endif
  324.  
  325.  
  326. if(icle.eq.1) then
  327. do jl = 2,ncle
  328. call FATIG3(sigcyc,pcyc,ycyc,nbrobl,ncycl,jl,cofa1,cofa2,
  329. &ycri,SDCYC,ib,igau)
  330. melval = mcham2.ielval(jl-1)
  331. velche(igau,ib) = ycri
  332. enddo
  333. else
  334. call FATIG3(sigcyc,pcyc,ycyc,nbrobl,ncycl,icle,cofa1,cofa2,
  335. &ycri,SDCYC,ib,igau)
  336. endif
  337.  
  338. if(icle.gt.1) then
  339. melval = mcham2.ielval(1)
  340. velche(igau,ib) = ycri
  341. endif
  342.  
  343. if((icle.eq.2.or.icle.eq.3).and.ib.eq.1.and.igau.eq.1) then
  344. melval = mcham2.ielval(2)
  345. kevdvk = ielche(1,1)
  346. endif
  347.  
  348. if(icle.eq.2.or.icle.eq.3) then
  349. if (ycri.gt.zecrit) then
  350. melval = mcham2.ielval(2)
  351. n = 2
  352. segini mevoll
  353. ielche(igau,ib) = mevoll
  354. ITYEVO='REEL'
  355. IEVTEX='CYCLE P/TAU '
  356. IEVTEX(13:20) = mchel1.titche(9:16)
  357. segini kevoll
  358. ievoll(1) = kevoll
  359. ievoll(2) = kevdvk
  360. jg = ncycl
  361. segini mlreel
  362. iprogx = mlreel
  363. segini mlree1
  364. iprogy = mlree1
  365. NUMEVY='REEL'
  366. NOMEVX = 'P'
  367. NOMEVY = 'TAU'
  368. TYPX = 'LISTREEL'
  369. TYPY = 'LISTREEL'
  370.  
  371. do jcyc = 1,ncycl
  372. mlree1.prog(jcyc) = ycyc(jcyc)
  373. prog(jcyc) = pcyc(jcyc)
  374. enddo
  375. segdes mlreel,mlree1
  376. segdes kevoll
  377. segdes mevoll
  378. else
  379. melval = mcham2.ielval(2)
  380. ielche(igau,ib) = mevnul
  381. endif
  382. endif
  383.  
  384. * boucle igau
  385. enddo
  386. * boucle ib
  387. ENDDO
  388.  
  389.  
  390. if(icle.eq.2.or.icle.eq.3) then
  391. kevoll = kevdvk
  392. mlreel = iprogx
  393. mlree1 = iprogy
  394. if (abs(pcymin).le.1.e-6.and.abs(pcymax).le.1.e-6) then
  395. pcymin = -1.D0
  396. pcymax = 1.D0
  397. elseif (abs((pcymax - pcymin)/pcymax).le.0.1) then
  398. pcymin = pcymin - 0.1*abs(pcymax)
  399. pcycmax = pcymax + 0.1*abs(pcymax)
  400. endif
  401. prog(1) = pcymin
  402. prog(2) = pcymax
  403. cofa1 = cofa1*(-1)
  404. mlree1.prog(1) = cofa1*pcymin + cofa2
  405. mlree1.prog(2) = cofa1*pcymax + cofa2
  406. segdes mlreel,mlree1
  407. segdes kevoll
  408. endif
  409.  
  410. do lt = 1,ktem
  411. do iobl = 1, nbrobl
  412. melval = lcysig(iobl,lt)
  413. if(melval.gt.0) segdes melval
  414. enddo
  415. enddo
  416. if(icle.lt.ncle) segdes melva1,melva2
  417. segsup mdevsi
  418. segsup mcysig
  419. segsup mrecyc
  420. segdes imodel
  421. mchaml = mchel2.ichaml(ik)
  422. if(icle.eq.1) then
  423. do jf = 1,ncle-1
  424. melval = ielval(jf)
  425. segdes melval
  426. enddo
  427. elseif(icle.eq.2.or.icle.eq.3) then
  428. do jf = 1,2
  429. melval = ielval(jf)
  430. segdes melval
  431. enddo
  432. elseif(icle.gt.3) then
  433. melval = ielval(1)
  434. segdes melval
  435. endif
  436. segdes mchaml
  437. * boucle ik
  438. ENDDO
  439.  
  440. if(ICF1.gt.0) segdes mchel1
  441. segdes mmodel,mchel2
  442. ICHOUT = MCHEL2
  443. RETURN
  444. END
  445.  
  446.  
  447.  
  448.  
  449.  

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