Télécharger cprefib.eso

Retour à la liste

Numérotation des lignes :

cprefib
  1. C CPREFIB SOURCE FD218221 24/02/07 21:15:08 11834
  2. SUBROUTINE CPREFIB(IPMODL,MLMOTS,ISUP,ICARA)
  3. *----------------------------------------------------------------------------------------------
  4. * preconditionnement caracteristiques materiau pour modele de fibres
  5. * dans FLDO3D
  6. *----------------------------------------------------------------------------------------------
  7. *
  8. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  9. * -----------
  10. *
  11. * IPMODL (E) POINTEUR D'OBJET MODELE
  12. * MLMOTS (E) POINTEUR SUR LE LISTMOTS DE CARACTERISTIQUES
  13. * ISUP (E) NUMERO DE SUPPORT DEMANDE
  14. * ICARA (E+S) POINTEUR SUR LE CHAMELEM
  15. *
  16. * LANGAGE:
  17. * --------
  18. *
  19. * ESOPE + FORTRAN77
  20. *
  21. *-----------------------------------------------------------------------
  22. *
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. REAL*8 COEFFK1(10),COEFFK2(10),COEFFWP1(10),COEFFWP2(10)
  27. REAL*8 COEFFFP(10),COEFFWF(10),COEFFW03(10),MAXFP,MINFP
  28. REAL*8 MAXWP1,MINWP1,MAXWP2,MINWP2,MAXWF,MINWF,MAXW03,MINW03
  29. REAL*8 MAXK02,MINK02,MAXK01,MINK01
  30.  
  31.  
  32. PARAMETER (XUnDemi=0.5,XUn=1.)
  33.  
  34. parameter (niter=20,nligne=10000)
  35. parameter (nangl=7,nlongfi=60,nrt=8)
  36. parameter (phit=80.d0,phicrit=50.d0)
  37. parameter (nangredu=int(phicrit*nangl/phit+1))
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC CCHAMP
  42. -INC SMCHAML
  43. -INC SMMODEL
  44. -INC SMCOORD
  45. -INC SMLMOTS
  46. -INC SMLREEL
  47. *
  48. * SEGMENT INFO
  49. * INTEGER INFELE(JG)
  50. * ENDSEGMENT
  51.  
  52. SEGMENT MWOR
  53. real*8 fel(mligne),ld1(mligne,miter),ld2(mligne,miter)
  54. real*8 sp1(mligne),fcrit1(mligne,miter),fcrit2(mligne,miter)
  55. real*8 L1(mligne,miter),L2(mligne,miter),dls1(mligne,miter)
  56. real*8 dls2(mligne,miter),ls1(mligne,miter),ls2(mligne,miter)
  57. real*8 F(mligne,miter),w1(mligne,miter),w2(mligne,miter)
  58. real*8 Fd1(mligne,miter),sd1(mligne,miter),lsf1(mligne)
  59. real*8 sel1(mligne,miter),sdf1(mligne)
  60. real*8 Fo(mligne,miter),ldf2(mligne),Ffo(mligne)
  61. real*8 lsf2(mligne),Lf2(mligne),sdf2(mligne),Fco(mligne)
  62. real*8 sd2(mligne,miter),sel2(mligne,miter)
  63. real*8 Dwf(mligne),Ff(mligne),Lf1(mligne),ldf1(mligne)
  64. real*8 ffo2(mligne,mangl1,mlongfi)
  65. real*8 Ffo1(mligne,mangl1,mlongfi)
  66. real*8 FmoyL(mligne,mangl1),wf1(mligne,mangl1,mlongfi)
  67. real*8 Fmoylis(mligne),wlist(mligne)
  68. *
  69. real*8 lisRt(mrtang1),lisphid(mrtang1)
  70. real*8 lisfp(mrtang1),lisk0m(mrtang1)
  71. real*8 liswf(mrtang1)
  72. real*8 lisw03(mrtang1)
  73. *
  74. real*8 lisrt1(mangnrt),lisphid1(mangnrt)
  75. real*8 lisrt2(mangnan)
  76. real*8 lisphid2(mangnan)
  77. real*8 liswp1(mangnrt),liswp2(mangnan)
  78. real*8 lisk01(mangnrt),lisk02(mangnan)
  79. ENDSEGMENT
  80. *
  81. CHARACTER*(NCONCH) CONM
  82. *
  83. SEGACT,MLMOTS
  84. *
  85. * La composante 'K1' existe t-elle deja? Si oui, on considere que le preconditionnement
  86. * a deja ete fait et on s'en va.
  87. * A adapter pour le modele de fibres
  88. *
  89. DO 1 I=1,MOTS(/2)
  90. IF(MOTS(I).EQ.'K11') THEN
  91. SEGDES MLMOTS
  92. RETURN
  93. ENDIF
  94. 1 CONTINUE
  95. *
  96. * ACTIVATIONS
  97. *
  98. MMODEL=IPMODL
  99. NSOUS=KMODEL(/1)
  100. MCHELM=ICARA
  101. SEGACT MCHELM
  102.  
  103.  
  104. *
  105. * BOUCLE SUR LES SOUS ZONES DU MODELE
  106. *
  107. DO 200 ISOUS=1,NSOUS
  108.  
  109. *
  110. * TRAITEMENT DU MODELE
  111. *
  112. IMODEL=KMODEL(ISOUS)
  113. MELE =NEFMOD
  114. IPMAIL=IMAMOD
  115. CONM =CONMOD
  116. *
  117. *
  118. * INFORMATIONS SUR L'{L{MENT FINI
  119. *
  120. * CALL ELQUOI(MELE,0,ISUP,INFO,IMODEL)
  121. IF (IERR.NE.0) THEN
  122. SEGDES MCHELM
  123. RETURN
  124. ENDIF
  125. MFR =INFELE(13)
  126. LHOOK=INFELE(10)
  127. IF(MFR.NE.1) THEN
  128. * SEGSUP INFO
  129. GO TO 200
  130. ENDIF
  131. *
  132. * RECHERCHE DE LA ZONE DU CHAMELEM
  133. *
  134. N1 = IMACHE(/1)
  135. N3 = INFCHE(/2)
  136. LAZON = 0
  137. DO 11 I=1,N1
  138. IF (IPMAIL.NE.IMACHE(I) .OR.
  139. . CONM.NE.CONCHE(I)) GO TO 11
  140. LAZON=I
  141. GO TO 12
  142. 11 CONTINUE
  143. *
  144. CALL ERREUR(472)
  145. SEGDES MCHELM
  146. * SEGSUP INFO
  147. RETURN
  148. *
  149. 12 CONTINUE
  150. MCHAML=ICHAML(LAZON)
  151. SEGACT MCHAML
  152. N2=NOMCHE(/2)
  153. NPAR=84
  154. * print *, 'N2=',N2
  155.  
  156. * on cherche les indices des parametres materiau necessaires aux calculs du preconditionnement
  157. * par exemple le diametre des fibres et la longueur des fibres
  158. IVDIFI=0
  159. IVLOFI=0
  160. IVHFI=0
  161. IVTMAX=0
  162. IVTD=0
  163. IVSK=0
  164. IVFABO=0
  165. IVALEC=0
  166. IVMECR=0
  167. IVLCAN=0
  168. IVMUF=0
  169. IVYOFI=0
  170. IVLECH=0
  171. IVMW=0
  172. IVFU=0
  173. IVRTEC=0
  174. IVFYF=0
  175. c
  176. JVDIFI=0
  177. JVLOFI=0
  178. JVHFI=0
  179. JVTMAX=0
  180. JVTD=0
  181. JVSK=0
  182. JVFABO=0
  183. JVALEC=0
  184. JVMECR=0
  185. JVLCAN=0
  186. JVMUF=0
  187. JVYOFI=0
  188. JVLECH=0
  189. JVMW=0
  190. JVFU=0
  191. JVRTEC=0
  192. JVFYF=0
  193.  
  194. do i=1,n2
  195. if(NOMCHE(i).EQ.'DIFI') then
  196. IVDIFI=i
  197. JVDIFI=1
  198. endif
  199. if(NOMCHE(i).EQ.'LOFI') then
  200. IVLOFI=i
  201. JVLOFI=1
  202. endif
  203. if(NOMCHE(i).EQ.'HFI') then
  204. IVHFI=i
  205. JVHFI=1
  206. endif
  207. if(NOMCHE(i).EQ.'TMAX') then
  208. IVTMAX=i
  209. JVTMAX=1
  210. endif
  211. if(NOMCHE(i).EQ.'TD') then
  212. IVTD=i
  213. JVTD=1
  214. endif
  215. if(NOMCHE(i).EQ.'SK') then
  216. IVSK=i
  217. JVSK=1
  218. endif
  219. if(NOMCHE(i).EQ.'FABO') then
  220. IVFABO=i
  221. JVFABO=1
  222. endif
  223. if(NOMCHE(i).EQ.'ALEC') then
  224. IVALEC=i
  225. JVALEC=1
  226. endif
  227. if(NOMCHE(i).EQ.'MECR') then
  228. IVMECR=i
  229. JVMECR=1
  230. endif
  231. if(NOMCHE(i).EQ.'LCAN') then
  232. IVLCAN=i
  233. JVLCAN=1
  234. endif
  235. if(NOMCHE(i).EQ.'MUF') then
  236. IVMUF=i
  237. JVMUF=1
  238. endif
  239. if(NOMCHE(i).EQ.'YOFI') then
  240. IVYOFI=i
  241. JVYOFI=1
  242. endif
  243. if(NOMCHE(i).EQ.'LECH') then
  244. IVLECH=i
  245. JVLECH=1
  246. endif
  247. if(NOMCHE(i).EQ.'MW') then
  248. IVMW=i
  249. JVMW=1
  250. endif
  251. if(NOMCHE(i).EQ.'FU') then
  252. IVFU=i
  253. JVFU=1
  254. endif
  255. if(NOMCHE(i).EQ.'RTEC') then
  256. IVRTEC=i
  257. JVRTEC=1
  258. endif
  259. if(NOMCHE(i).EQ.'FYF') then
  260. IVFYF=i
  261. JVFYF=1
  262. endif
  263. enddo
  264.  
  265. * on teste si il faut continuer ou sortir de cprefib
  266.  
  267. isomm = JVDIFI+JVLOFI+JVHFI+JVTMAX+JVTD+JVSK+JVFABO
  268. & +JVALEC+JVMECR+JVLCAN+JVMUF+JVYOFI+JVLECH+JVMW
  269. & +JVFU+JVRTEC+JVFYF
  270.  
  271. if(isomm.eq.0) then
  272. SEGDES MCHAML
  273. SEGDES MCHELM
  274. RETURN
  275. else if (isomm.ne.17) then
  276. call erreur(5)
  277. SEGDES MCHAML
  278. SEGDES MCHELM
  279. RETURN
  280. endif
  281.  
  282.  
  283. *
  284. * on va ajouter les composantes associees aux parametres des surfaces ( 3 pour l'exemple : K1, K2, K3)
  285. * a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  286. * calcules par preconditionnement
  287. *
  288. N2A = N2
  289. N2=N2A+NPAR
  290. SEGADJ MCHAML
  291. * on ajuste la taille du segment
  292. * rigidite initiale 1
  293. NOMCHE(N2A+1)='K11'
  294. TYPCHE(N2A+1)='REAL*8'
  295. NOMCHE(N2A+2)='K12'
  296. TYPCHE(N2A+2)='REAL*8'
  297. NOMCHE(N2A+3)='K13'
  298. TYPCHE(N2A+3)='REAL*8'
  299. NOMCHE(N2A+4)='K14'
  300. TYPCHE(N2A+4)='REAL*8'
  301. NOMCHE(N2A+5)='K15'
  302. TYPCHE(N2A+5)='REAL*8'
  303. NOMCHE(N2A+6)='K16'
  304. TYPCHE(N2A+6)='REAL*8'
  305. NOMCHE(N2A+7)='K17'
  306. TYPCHE(N2A+7)='REAL*8'
  307. NOMCHE(N2A+8)='K18'
  308. TYPCHE(N2A+8)='REAL*8'
  309. NOMCHE(N2A+9)='K19'
  310. TYPCHE(N2A+9)='REAL*8'
  311. NOMCHE(N2A+10)='K110'
  312. TYPCHE(N2A+10)='REAL*8'
  313. * rigidite initiale 2
  314. NOMCHE(N2A+11)='K21'
  315. TYPCHE(N2A+11)='REAL*8'
  316. NOMCHE(N2A+12)='K22'
  317. TYPCHE(N2A+12)='REAL*8'
  318. NOMCHE(N2A+13)='K23'
  319. TYPCHE(N2A+13)='REAL*8'
  320. NOMCHE(N2A+14)='K24'
  321. TYPCHE(N2A+14)='REAL*8'
  322. NOMCHE(N2A+15)='K25'
  323. TYPCHE(N2A+15)='REAL*8'
  324. NOMCHE(N2A+16)='K26'
  325. TYPCHE(N2A+16)='REAL*8'
  326. NOMCHE(N2A+17)='K27'
  327. TYPCHE(N2A+17)='REAL*8'
  328. NOMCHE(N2A+18)='K28'
  329. TYPCHE(N2A+18)='REAL*8'
  330. NOMCHE(N2A+19)='K29'
  331. TYPCHE(N2A+19)='REAL*8'
  332. NOMCHE(N2A+20)='K210'
  333. TYPCHE(N2A+20)='REAL*8'
  334. * ouverture au pic 1
  335. NOMCHE(N2A+21)='W11'
  336. TYPCHE(N2A+21)='REAL*8'
  337. NOMCHE(N2A+22)='W12'
  338. TYPCHE(N2A+22)='REAL*8'
  339. NOMCHE(N2A+23)='W13'
  340. TYPCHE(N2A+23)='REAL*8'
  341. NOMCHE(N2A+24)='W14'
  342. TYPCHE(N2A+24)='REAL*8'
  343. NOMCHE(N2A+25)='W15'
  344. TYPCHE(N2A+25)='REAL*8'
  345. NOMCHE(N2A+26)='W16'
  346. TYPCHE(N2A+26)='REAL*8'
  347. NOMCHE(N2A+27)='W17'
  348. TYPCHE(N2A+27)='REAL*8'
  349. NOMCHE(N2A+28)='W18'
  350. TYPCHE(N2A+28)='REAL*8'
  351. NOMCHE(N2A+29)='W19'
  352. TYPCHE(N2A+29)='REAL*8'
  353. NOMCHE(N2A+30)='W110'
  354. TYPCHE(N2A+30)='REAL*8'
  355. * ouverture au pic 2
  356. NOMCHE(N2A+31)='W21'
  357. TYPCHE(N2A+31)='REAL*8'
  358. NOMCHE(N2A+32)='W22'
  359. TYPCHE(N2A+32)='REAL*8'
  360. NOMCHE(N2A+33)='W23'
  361. TYPCHE(N2A+33)='REAL*8'
  362. NOMCHE(N2A+34)='W24'
  363. TYPCHE(N2A+34)='REAL*8'
  364. NOMCHE(N2A+35)='W25'
  365. TYPCHE(N2A+35)='REAL*8'
  366. NOMCHE(N2A+36)='W26'
  367. TYPCHE(N2A+36)='REAL*8'
  368. NOMCHE(N2A+37)='W27'
  369. TYPCHE(N2A+37)='REAL*8'
  370. NOMCHE(N2A+38)='W28'
  371. TYPCHE(N2A+38)='REAL*8'
  372. NOMCHE(N2A+39)='W29'
  373. TYPCHE(N2A+39)='REAL*8'
  374. NOMCHE(N2A+40)='W210'
  375. TYPCHE(N2A+40)='REAL*8'
  376. * Force au pic
  377. NOMCHE(N2A+41)='FP1'
  378. TYPCHE(N2A+41)='REAL*8'
  379. NOMCHE(N2A+42)='FP2'
  380. TYPCHE(N2A+42)='REAL*8'
  381. NOMCHE(N2A+43)='FP3'
  382. TYPCHE(N2A+43)='REAL*8'
  383. NOMCHE(N2A+44)='FP4'
  384. TYPCHE(N2A+44)='REAL*8'
  385. NOMCHE(N2A+45)='FP5'
  386. TYPCHE(N2A+45)='REAL*8'
  387. NOMCHE(N2A+46)='FP6'
  388. TYPCHE(N2A+46)='REAL*8'
  389. NOMCHE(N2A+47)='FP7'
  390. TYPCHE(N2A+47)='REAL*8'
  391. NOMCHE(N2A+48)='FP8'
  392. TYPCHE(N2A+48)='REAL*8'
  393. NOMCHE(N2A+49)='FP9'
  394. TYPCHE(N2A+49)='REAL*8'
  395. NOMCHE(N2A+50)='FP10'
  396. TYPCHE(N2A+50)='REAL*8'
  397. * ouverture intermediaire a 0.3fp
  398. NOMCHE(N2A+51)='W31'
  399. TYPCHE(N2A+51)='REAL*8'
  400. NOMCHE(N2A+52)='W32'
  401. TYPCHE(N2A+52)='REAL*8'
  402. NOMCHE(N2A+53)='W33'
  403. TYPCHE(N2A+53)='REAL*8'
  404. NOMCHE(N2A+54)='W34'
  405. TYPCHE(N2A+54)='REAL*8'
  406. NOMCHE(N2A+55)='W35'
  407. TYPCHE(N2A+55)='REAL*8'
  408. NOMCHE(N2A+56)='W36'
  409. TYPCHE(N2A+56)='REAL*8'
  410. NOMCHE(N2A+57)='W37'
  411. TYPCHE(N2A+57)='REAL*8'
  412. NOMCHE(N2A+58)='W38'
  413. TYPCHE(N2A+58)='REAL*8'
  414. NOMCHE(N2A+59)='W39'
  415. TYPCHE(N2A+59)='REAL*8'
  416. NOMCHE(N2A+60)='W310'
  417. TYPCHE(N2A+60)='REAL*8'
  418. * ouverture finale f=0
  419. NOMCHE(N2A+61)='WF1'
  420. TYPCHE(N2A+61)='REAL*8'
  421. NOMCHE(N2A+62)='WF2'
  422. TYPCHE(N2A+62)='REAL*8'
  423. NOMCHE(N2A+63)='WF3'
  424. TYPCHE(N2A+63)='REAL*8'
  425. NOMCHE(N2A+64)='WF4'
  426. TYPCHE(N2A+64)='REAL*8'
  427. NOMCHE(N2A+65)='WF5'
  428. TYPCHE(N2A+65)='REAL*8'
  429. NOMCHE(N2A+66)='WF6'
  430. TYPCHE(N2A+66)='REAL*8'
  431. NOMCHE(N2A+67)='WF7'
  432. TYPCHE(N2A+67)='REAL*8'
  433. NOMCHE(N2A+68)='WF8'
  434. TYPCHE(N2A+68)='REAL*8'
  435. NOMCHE(N2A+69)='WF9'
  436. TYPCHE(N2A+69)='REAL*8'
  437. NOMCHE(N2A+70)='WF10'
  438. TYPCHE(N2A+70)='REAL*8'
  439. * min et max des listes calculees
  440. NOMCHE(N2A+71)='K1MI'
  441. TYPCHE(N2A+71)='REAL*8'
  442. NOMCHE(N2A+72)='K1MA'
  443. TYPCHE(N2A+72)='REAL*8'
  444. NOMCHE(N2A+73)='K2MI'
  445. TYPCHE(N2A+73)='REAL*8'
  446. NOMCHE(N2A+74)='K2MA'
  447. TYPCHE(N2A+74)='REAL*8'
  448. NOMCHE(N2A+75)='W1MI'
  449. TYPCHE(N2A+75)='REAL*8'
  450. NOMCHE(N2A+76)='W1MA'
  451. TYPCHE(N2A+76)='REAL*8'
  452. NOMCHE(N2A+77)='W2MI'
  453. TYPCHE(N2A+77)='REAL*8'
  454. NOMCHE(N2A+78)='W2MA'
  455. TYPCHE(N2A+78)='REAL*8'
  456. NOMCHE(N2A+79)='FPMI'
  457. TYPCHE(N2A+79)='REAL*8'
  458. NOMCHE(N2A+80)='FPMA'
  459. TYPCHE(N2A+80)='REAL*8'
  460. NOMCHE(N2A+81)='W3MI'
  461. TYPCHE(N2A+81)='REAL*8'
  462. NOMCHE(N2A+82)='W3MA'
  463. TYPCHE(N2A+82)='REAL*8'
  464. NOMCHE(N2A+83)='WFMI'
  465. TYPCHE(N2A+83)='REAL*8'
  466. NOMCHE(N2A+84)='WFMA'
  467. TYPCHE(N2A+84)='REAL*8'
  468.  
  469.  
  470.  
  471. * MELEME=IPMAIL
  472. * SEGACT MELEME
  473. * NBNN=NUM(/1)
  474. *
  475. * CREATION DES MELVALs ET REMPLISSAGE
  476. *
  477. * on gere d'abord la taille necessaire, en fonction de la taille des autres parametres materiau
  478.  
  479. N1EL=0
  480. N1PTEL=0
  481. MELVAL=IELVAL(IVDIFI)
  482. NGDIFI=VELCHE(/1)
  483. NBDIFI=VELCHE(/2)
  484.  
  485. MELVAL=IELVAL(IVLOFI)
  486. NGLOFI=VELCHE(/1)
  487. NBLOFI=VELCHE(/2)
  488.  
  489. MELVAL=IELVAL(IVHFI)
  490. NGHFI=VELCHE(/1)
  491. NBHFI=VELCHE(/2)
  492.  
  493. MELVAL=IELVAL(IVTMAX)
  494. NGTMAX=VELCHE(/1)
  495. NBTMAX=VELCHE(/2)
  496.  
  497. MELVAL=IELVAL(IVTD)
  498. NGTD=VELCHE(/1)
  499. NBTD=VELCHE(/2)
  500.  
  501. MELVAL=IELVAL(IVSK)
  502. NGSK=VELCHE(/1)
  503. NBSK=VELCHE(/2)
  504.  
  505. MELVAL=IELVAL(IVFABO)
  506. NGFABO=VELCHE(/1)
  507. NBFABO=VELCHE(/2)
  508.  
  509. MELVAL=IELVAL(IVALEC)
  510. NGALEC=VELCHE(/1)
  511. NBALEC=VELCHE(/2)
  512.  
  513. MELVAL=IELVAL(IVMECR)
  514. NGMECR=VELCHE(/1)
  515. NBMECR=VELCHE(/2)
  516.  
  517. MELVAL=IELVAL(IVLCAN)
  518. NGLCAN=VELCHE(/1)
  519. NBLCAN=VELCHE(/2)
  520.  
  521. MELVAL=IELVAL(IVMUF)
  522. NGMUF=VELCHE(/1)
  523. NBMUF=VELCHE(/2)
  524.  
  525. MELVAL=IELVAL(IVYOFI)
  526. NGYOFI=VELCHE(/1)
  527. NBYOFI=VELCHE(/2)
  528.  
  529. MELVAL=IELVAL(IVLECH)
  530. NGLECH=VELCHE(/1)
  531. NBLECH=VELCHE(/2)
  532.  
  533. MELVAL=IELVAL(IVMW)
  534. NGMW=VELCHE(/1)
  535. NBMW=VELCHE(/2)
  536.  
  537. MELVAL=IELVAL(IVFU)
  538. NGFU=VELCHE(/1)
  539. NBFU=VELCHE(/2)
  540.  
  541. MELVAL=IELVAL(IVRTEC)
  542. NGRTEC=VELCHE(/1)
  543. NBRTEC=VELCHE(/2)
  544.  
  545. MELVAL=IELVAL(IVFYF)
  546. NGFYF=VELCHE(/1)
  547. NBFYF=VELCHE(/2)
  548.  
  549. *Ici on est en train de regarder si les données mx sont constantes sur le maillage et dans les elements ?
  550. IF(NGDIFI.EQ.1.AND.NGLOFI.EQ.1.AND.NGHFI.EQ.1.AND.NGTMAX.EQ.1
  551. #.AND.NGTD.EQ.1.AND.NGSK.EQ.1.AND.NGFABO.EQ.1.AND.NGALEC.EQ.1.
  552. #AND.NGMECR.EQ.1.AND.NGLCAN.EQ.1.AND.NGMUF.EQ.1.AND.NGYOFI.EQ.1
  553. #.AND.NGLECH.EQ.1.AND.NGMW.EQ.1.AND.NGFU.EQ.1.AND.NGRTEC.EQ.1
  554. # .AND.NGFYF.EQ.1) THEN
  555. N1PTEL=1
  556. ELSE
  557. N1PTEL=MAX(NGDIFI,NGLOFI,NGHFI,NGTMAX,NGTD,NGSK,NGFABO,NGALEC,
  558. #NGMECR,NGLCAN,NGMUF,NGYOFI,NGLECH,NGMW,NGFU,NGRTEC,NGFYF)
  559. ENDIF
  560. IF(NBDIFI.EQ.1.AND.NBLOFI.EQ.1.AND.NBHFI.EQ.1.AND.NBTMAX.EQ.1
  561. #.AND.NBTD.EQ.1.AND.NBSK.EQ.1.AND.NBFABO.EQ.1.AND.NBALEC.EQ.1.
  562. #AND.NBMECR.EQ.1.AND.NBLCAN.EQ.1.AND.NBMUF.EQ.1.AND.NBYOFI.EQ.1
  563. #.AND.NBLECH.EQ.1.AND.NBMW.EQ.1.AND.NBFU.EQ.1.AND.NBRTEC.EQ.1
  564. #.AND.NBFYF.EQ.1) THEN
  565. N1EL=1
  566. ELSE
  567. N1EL=MAX(NBDIFI,NBLOFI,NBHFI,NBTMAX,NBTD,NBSK,NBFABO,NBALEC,
  568. #NBMECR,NBLCAN,NBMUF,NBYOFI,NBLECH,NBMW,NBFU,NBRTEC,NBFYF)
  569. ENDIF
  570. N2EL=0
  571. N2PTEL=0
  572.  
  573. * creation des 3 melvals, associés à K1,K2,K3
  574. * a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  575. * calcules par preconditionnement
  576.  
  577. DO I=1,NPAR
  578. SEGINI MELVAL
  579. IELVAL(N2A+I)=MELVAL
  580. ENDDO
  581.  
  582.  
  583. * on crée un segment de travail
  584. MLIGNE = nligne
  585. MITER = niter
  586. MANGL1 = nangl+1
  587. MLONGFI = nlongfi
  588. MRTANG1 = nrt*(nangl+1)
  589. MANGNRT = nangredu*nrt
  590. MANGNAN = (nangl+1-nangredu)*nrt
  591. SEGINI MWOR
  592.  
  593.  
  594.  
  595. *
  596. * calcul de K1,K2,K3
  597. * boucle sur les elements et sur les points de Gauss
  598. * donc si le champ est constant sur le maillage et les elements niel = 1 et n1ptel=1 et on va faire l'appel qu'une seule fois
  599. DO IB=1,N1EL
  600. DO IGAU=1,N1PTEL
  601. * recuperation du diametre de la fibre
  602. MELVAL=IELVAL(IVDIFI)
  603. IGMN=MIN(IGAU,VELCHE(/1))
  604. IBMN=MIN(IB ,VELCHE(/2))
  605. XDIFI =VELCHE(IGMN,IBMN)
  606. * recuperation de la longueur de la fibre
  607. MELVAL=IELVAL(IVLOFI)
  608. IGMN=MIN(IGAU,VELCHE(/1))
  609. IBMN=MIN(IB ,VELCHE(/2))
  610. XLOFI =VELCHE(IGMN,IBMN)
  611. * recuperation de la rigidite de l interface
  612. MELVAL=IELVAL(IVHFI)
  613. IGMN=MIN(IGAU,VELCHE(/1))
  614. IBMN=MIN(IB ,VELCHE(/2))
  615. XHFI =VELCHE(IGMN,IBMN)
  616. * recuperation de la contrainte de cisaillement max
  617. MELVAL=IELVAL(IVTMAX)
  618. IGMN=MIN(IGAU,VELCHE(/1))
  619. IBMN=MIN(IB ,VELCHE(/2))
  620. XTMAX =VELCHE(IGMN,IBMN)
  621. * recuperation de la contrainte de frottement
  622. MELVAL=IELVAL(IVTD)
  623. IGMN=MIN(IGAU,VELCHE(/1))
  624. IBMN=MIN(IB ,VELCHE(/2))
  625. XTD =VELCHE(IGMN,IBMN)
  626. * recuperation du glissement caracteristique
  627. MELVAL=IELVAL(IVSK)
  628. IGMN=MIN(IGAU,VELCHE(/1))
  629. IBMN=MIN(IB ,VELCHE(/2))
  630. XSK =VELCHE(IGMN,IBMN)
  631. * recuperation de la contrainte de la force d about
  632. MELVAL=IELVAL(IVFABO)
  633. IGMN=MIN(IGAU,VELCHE(/1))
  634. IBMN=MIN(IB ,VELCHE(/2))
  635. XFABO =VELCHE(IGMN,IBMN)
  636. * recuperation de l angle du cone de rupture et d ecaill
  637. MELVAL=IELVAL(IVALEC)
  638. IGMN=MIN(IGAU,VELCHE(/1))
  639. IBMN=MIN(IB ,VELCHE(/2))
  640. XALEC =VELCHE(IGMN,IBMN)
  641. * recuperation du module d ecrouissage d abrasion
  642. MELVAL=IELVAL(IVMECR)
  643. IGMN=MIN(IGAU,VELCHE(/1))
  644. IBMN=MIN(IB ,VELCHE(/2))
  645. XMECR =VELCHE(IGMN,IBMN)
  646. * recuperation de la longueur dancrage caracteristique
  647. MELVAL=IELVAL(IVLCAN)
  648. IGMN=MIN(IGAU,VELCHE(/1))
  649. IBMN=MIN(IB ,VELCHE(/2))
  650. XLCAN =VELCHE(IGMN,IBMN)
  651. * recuperation du coefficient de frottement fibre matrice
  652. MELVAL=IELVAL(IVMUF)
  653. IGMN=MIN(IGAU,VELCHE(/1))
  654. IBMN=MIN(IB ,VELCHE(/2))
  655. XMUF =VELCHE(IGMN,IBMN)
  656. * recuperation du module d elasticite de la fibre
  657. MELVAL=IELVAL(IVYOFI)
  658. IGMN=MIN(IGAU,VELCHE(/1))
  659. IBMN=MIN(IB ,VELCHE(/2))
  660. XYOFI =VELCHE(IGMN,IBMN)
  661. * recuperation de la longueur de l echantillon qui a donne RTEC
  662. MELVAL=IELVAL(IVLECH)
  663. IGMN=MIN(IGAU,VELCHE(/1))
  664. IBMN=MIN(IB ,VELCHE(/2))
  665. XLECH =VELCHE(IGMN,IBMN)
  666. * recuperation du parametre de weibull
  667. MELVAL=IELVAL(IVMW)
  668. IGMN=MIN(IGAU,VELCHE(/1))
  669. IBMN=MIN(IB ,VELCHE(/2))
  670. XMW =VELCHE(IGMN,IBMN)
  671. * recuperation de la contrainte ultime des fibres
  672. MELVAL=IELVAL(IVFU)
  673. IGMN=MIN(IGAU,VELCHE(/1))
  674. IBMN=MIN(IB ,VELCHE(/2))
  675. XFU =VELCHE(IGMN,IBMN)
  676. * recuperation de la resistance a la traction associee a lech
  677. MELVAL=IELVAL(IVRTEC)
  678. IGMN=MIN(IGAU,VELCHE(/1))
  679. IBMN=MIN(IB ,VELCHE(/2))
  680. XRTEC =VELCHE(IGMN,IBMN)
  681. * recuperation de la LIMITE ELASTIQUE DES FIBRES
  682. MELVAL=IELVAL(IVFYF)
  683. IGMN=MIN(IGAU,VELCHE(/1))
  684. IBMN=MIN(IB ,VELCHE(/2))
  685. XFYF =VELCHE(IGMN,IBMN)
  686.  
  687.  
  688.  
  689. CALL PRPFI0(COEFFK1,COEFFK2,COEFFWP1,
  690. #COEFFWP2,COEFFFP,COEFFWF,COEFFW03,XLECH,XMW,
  691. #MAXFP,MINFP,MAXWP1,MINWP1,MAXWP2,MINWP2,MAXWF,
  692. #MINWF,MAXW03,MINW03,XLOFI,XMUF,XTD,XTMAX,XYOFI,XHFI,XDIFI,XSK,
  693. #XFABO,XALEC,XMECR,XFU,XLCAN,XRTEC,MAXK02,MINK02,MAXK01,MINK01,
  694. #XFYF,
  695. #mwor,nligne,niter,nangl,nlongfi,nrt,nangredu,phit,phicrit)
  696.  
  697.  
  698. C REMPLISSAGE DES RESULTATS
  699. C
  700. * a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  701. * calcules par preconditionnement
  702.  
  703. DO I=1,10
  704. MELVAL=IELVAL(N2A+I)
  705. VELCHE(IGAU,IB)=COEFFK1(I)
  706. ENDDO
  707.  
  708. DO I=1,10
  709. MELVAL=IELVAL(N2A+I+10)
  710. VELCHE(IGAU,IB)=COEFFK2(I)
  711. ENDDO
  712.  
  713. DO I=1,10
  714. MELVAL=IELVAL(N2A+I+20)
  715. VELCHE(IGAU,IB)=COEFFWP1(I)
  716. ENDDO
  717.  
  718. DO I=1,10
  719. MELVAL=IELVAL(N2A+I+30)
  720. VELCHE(IGAU,IB)=COEFFWP2(I)
  721. ENDDO
  722.  
  723. DO I=1,10
  724. MELVAL=IELVAL(N2A+I+40)
  725. VELCHE(IGAU,IB)=COEFFFP(I)
  726. ENDDO
  727.  
  728. DO I=1,10
  729. MELVAL=IELVAL(N2A+I+50)
  730. VELCHE(IGAU,IB)=COEFFW03(I)
  731. ENDDO
  732.  
  733. DO I=1,10
  734. MELVAL=IELVAL(N2A+I+60)
  735. VELCHE(IGAU,IB)=COEFFWF(I)
  736. ENDDO
  737.  
  738. c min et max des surfaces
  739. MELVAL=IELVAL(N2A+71)
  740. VELCHE(IGAU,IB)=MINK01
  741. MELVAL=IELVAL(N2A+72)
  742. VELCHE(IGAU,IB)=MAXK01
  743. MELVAL=IELVAL(N2A+73)
  744. VELCHE(IGAU,IB)=MINK02
  745. MELVAL=IELVAL(N2A+74)
  746. VELCHE(IGAU,IB)=MAXK02
  747. MELVAL=IELVAL(N2A+75)
  748. VELCHE(IGAU,IB)=MINWP1
  749. MELVAL=IELVAL(N2A+76)
  750. VELCHE(IGAU,IB)=MAXWP1
  751. MELVAL=IELVAL(N2A+77)
  752. VELCHE(IGAU,IB)=MINWP2
  753. MELVAL=IELVAL(N2A+78)
  754. VELCHE(IGAU,IB)=MAXWP2
  755. MELVAL=IELVAL(N2A+79)
  756. VELCHE(IGAU,IB)=MINFP
  757. MELVAL=IELVAL(N2A+80)
  758. VELCHE(IGAU,IB)=MAXFP
  759. MELVAL=IELVAL(N2A+81)
  760. VELCHE(IGAU,IB)=MINW03
  761. MELVAL=IELVAL(N2A+82)
  762. VELCHE(IGAU,IB)=MAXW03
  763. MELVAL=IELVAL(N2A+83)
  764. VELCHE(IGAU,IB)=MINWF
  765. MELVAL=IELVAL(N2A+84)
  766. VELCHE(IGAU,IB)=MAXWF
  767.  
  768.  
  769. *
  770. ENDDO
  771. ENDDO
  772. *
  773. * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  774. *
  775. * SEGDES MELEME
  776. MELVAL=IELVAL(IVDIFI)
  777. SEGDES MELVAL
  778. MELVAL=IELVAL(IVLOFI)
  779. SEGDES MELVAL
  780. MELVAL=IELVAL(IVHFI)
  781. SEGDES MELVAL
  782. MELVAL=IELVAL(IVTMAX)
  783. SEGDES MELVAL
  784. MELVAL=IELVAL(IVTD)
  785. SEGDES MELVAL
  786. MELVAL=IELVAL(IVSK)
  787. SEGDES MELVAL
  788. MELVAL=IELVAL(IVFABO)
  789. SEGDES MELVAL
  790. MELVAL=IELVAL(IVALEC)
  791. SEGDES MELVAL
  792. MELVAL=IELVAL(IVMECR)
  793. SEGDES MELVAL
  794. MELVAL=IELVAL(IVLCAN)
  795. SEGDES MELVAL
  796. MELVAL=IELVAL(IVMUF)
  797. SEGDES MELVAL
  798. MELVAL=IELVAL(IVYOFI)
  799. SEGDES MELVAL
  800. MELVAL=IELVAL(IVLECH)
  801. SEGDES MELVAL
  802. MELVAL=IELVAL(IVMW)
  803. SEGDES MELVAL
  804. MELVAL=IELVAL(IVFU)
  805. SEGDES MELVAL
  806. MELVAL=IELVAL(IVRTEC)
  807. SEGDES MELVAL
  808. MELVAL=IELVAL(IVFYF)
  809. SEGDES MELVAL
  810.  
  811.  
  812.  
  813. * a adapter pour le modele de fibres : remplacer 3 par le nombre de parametres
  814. * calcules par preconditionnement
  815.  
  816. DO I=1,NPAR
  817. MELVAL=IELVAL(N2A+I)
  818. SEGDES MELVAL
  819. ENDDO
  820. SEGDES MCHAML
  821.  
  822. * on supprime le segment de travail
  823. SEGSUP MWOR
  824.  
  825.  
  826.  
  827. * SEGSUP INFO
  828. *
  829. 200 CONTINUE
  830. *
  831. SEGDES MCHELM
  832. SEGDES,MLMOTS
  833. RETURN
  834. END
  835.  
  836.  
  837.  
  838.  
  839.  
  840.  
  841.  
  842.  
  843.  
  844.  
  845.  
  846.  
  847.  

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