Télécharger fatig2.eso

Retour à la liste

Numérotation des lignes :

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

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