Télécharger comval.eso

Retour à la liste

Numérotation des lignes :

comval
  1. C COMVAL SOURCE MB234859 23/02/03 21:15:08 11581
  2. SUBROUTINE COMVAL(iqmod,indeso,ililuc,iwrk52,iwrk53,ib,igau,iw522)
  3. C
  4. C----------------------------------------------------------------------
  5. C SUBROUTINE APPELEE PAR COML6
  6. C
  7. C OBJECTIF : RENSEIGNER LES SEGMENTS WRK52 et WRK522 (include DECHE)
  8. C AVEC LES VALEURS AU POINT D'INTEGRATION
  9. C
  10. C ENTREES :
  11. C ---------
  12. C IQMOD : POINTEUR SUR LE SEGMENT IMODEL
  13. C INDESO : ENTIER INDIQUANT DEBUT DE PAS (=1) FIN DE PAS (=2)
  14. C OU CHAMP RESULTAT (=3)
  15. C ILILUC : POINTEUR SUR LE SEGMENT LILUC (voir comouw)
  16. C IWRK53 : POINTEUR SUR LE SEGMENT WRK53
  17. C IB : ELEMENT COURANT
  18. C IGAU : POINT D'INTEGRATION COURANT
  19. C
  20. C SORTIES :
  21. C ---------
  22. C IWRK52 : POINTEUR SUR LE SEGMENT WRK52
  23. C IW522 : POINTEUR SUR LE SEGMENT WRK522
  24. C----------------------------------------------------------------------
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. *
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCGEOME
  31. -INC SMCHAML
  32. -INC SMELEME
  33. -INC SMCOORD
  34. -INC SMMODEL
  35. -INC SMINTE
  36. -INC CCHAMP
  37. -INC SMEVOLL
  38. -INC SMNUAGE
  39. * segment deroulant le mcheml
  40. -INC DECHE
  41. C
  42. C wrk52 contient les valeurs des differents champs
  43. C pour les materiaux, on a d'abord les composantes obligatoires
  44. C puis les composantes facultatives.
  45. C wrk522 ne sert que dans cette subroutine pour aider au remplissage
  46. C de wrk52
  47. C
  48. melval = 0
  49. imodel = iqmod
  50. liluc = ililuc
  51. nbluc1 = liluc(/1)
  52. wrk52 = iwrk52
  53. wrk53 = iwrk53
  54. wrk522 = iw522
  55. C
  56. C =================================================================
  57. C initialisations particulieres
  58. N2EL = 0
  59. N2PTEL=0
  60. * tuyaux (attention ajout de caracteristiques facultatives telles que DENS)
  61. IF (mfr.eq.13) THEN
  62. do ic = 1,5
  63. xcarb(ic) = 0.d0
  64. enddo
  65. do ic=6,10
  66. xcarb(ic) = -1.d0
  67. enddo
  68. do ic=11,xcarb(/1)
  69. xcarb(ic) = 0.d0
  70. enddo
  71. ENDIF
  72. C
  73. C =================================================================
  74. IF (ib+igau.ne.2) then
  75. C
  76. C COMPOSANTE SCAL
  77. if( mkkalz.EQ.1)then
  78. do 701 ma=1,mkkal0(/1)
  79. if(mkkal0(ma).eq.0) go to 701
  80. deche =mkkal0(ma)
  81. melval=ABS(ieldec)
  82. if (typree) then
  83. IBMN=MIN(IB,VELCHE(/2))
  84. IGMN=MIN(IGAU,VELCHE(/1))
  85. scal0(ma)=VELCHE(IGMN,IBMN)
  86. else
  87. IBMN=MIN(IB,IELCHE(/2))
  88. IGMN=MIN(IGAU,IELCHE(/1))
  89. scal0(ma)=DBLE(IELCHE(IGMN,IBMN))
  90. endif
  91. 701 continue
  92. do 7011 ma=1,mkklaf(/1)
  93. if(mkklaf(ma).eq.0) go to 7011
  94. deche =mkklaf(ma)
  95. melval=ABS(ieldec)
  96. if (typree) then
  97. IBMN=MIN(IB,VELCHE(/2))
  98. IGMN=MIN(IGAU,VELCHE(/1))
  99. scalf(ma)=VELCHE(IGMN,IBMN)
  100. else
  101. IBMN=MIN(IB,IELCHE(/2))
  102. IGMN=MIN(IGAU,IELCHE(/1))
  103. scalf(ma)=DBLE(IELCHE(IGMN,IBMN))
  104. endif
  105. 7011 continue
  106. endif
  107. C
  108. if(mkktp0.ne.0) then
  109. deche = mkktp0
  110. melval=ABS(ieldec)
  111. IBMN=MIN(IB,VELCHE(/2))
  112. IGMN=MIN(IGAU,VELCHE(/1))
  113. temp0=VELCHE(IGMN,IBMN)
  114. endif
  115. C
  116. if(mkktpf.ne.0) then
  117. deche = mkktpf
  118. melval=ABS(ieldec)
  119. IBMN=MIN(IB,VELCHE(/2))
  120. IGMN=MIN(IGAU,VELCHE(/1))
  121. tempf=VELCHE(IGMN,IBMN)
  122. endif
  123. C
  124. C COMPOSANTES PRIMALES
  125. if( mkkplz.EQ.1)then
  126. do 706 ma=1,mkkpl0(/1)
  127. if(mkkpl0(ma).eq.0) go to 706
  128. deche =mkkpl0(ma)
  129. melval=ABS(ieldec)
  130. if (typree) then
  131. IBMN=MIN(IB,VELCHE(/2))
  132. IGMN=MIN(IGAU,VELCHE(/1))
  133. depl0(ma)=VELCHE(IGMN,IBMN)
  134. else
  135. IBMN=MIN(IB,IELCHE(/2))
  136. IGMN=MIN(IGAU,IELCHE(/1))
  137. depl0(ma)=DBLE(IELCHE(IGMN,IBMN))
  138. endif
  139. 706 continue
  140. do 7061 ma=1,mkkplf(/1)
  141. if(mkkplf(ma).eq.0) go to 7061
  142. deche =mkkplf(ma)
  143. melval=ABS(ieldec)
  144. if (typree) then
  145. IBMN=MIN(IB,VELCHE(/2))
  146. IGMN=MIN(IGAU,VELCHE(/1))
  147. deplf(ma)=VELCHE(IGMN,IBMN)
  148. else
  149. IBMN=MIN(IB,IELCHE(/2))
  150. IGMN=MIN(IGAU,IELCHE(/1))
  151. deplf(ma)=DBLE(IELCHE(IGMN,IBMN))
  152. endif
  153. 7061 continue
  154. endif
  155. C
  156. C COMPOSANTES DUALES
  157. if(mkkrcz.eq.1) then
  158. do 707 ma=1,mkkrc0(/1)
  159. if(mkkrc0(ma).eq.0) go to 707
  160. deche =mkkrc0(ma)
  161. melval=ABS(ieldec)
  162. if (typree) then
  163. IBMN=MIN(IB,VELCHE(/2))
  164. IGMN=MIN(IGAU,VELCHE(/1))
  165. forc0(ma)=VELCHE(IGMN,IBMN)
  166. else
  167. IBMN=MIN(IB,IELCHE(/2))
  168. IGMN=MIN(IGAU,IELCHE(/1))
  169. forc0(ma)=DBLE(IELCHE(IGMN,IBMN))
  170. endif
  171. 707 continue
  172. do 7071 ma=1,mkkrcf(/1)
  173. if(mkkrcf(ma).eq.0) go to 7071
  174. deche =mkkrcf(ma)
  175. melval=ABS(ieldec)
  176. if (typree) then
  177. IBMN=MIN(IB,VELCHE(/2))
  178. IGMN=MIN(IGAU,VELCHE(/1))
  179. forcf(ma)=VELCHE(IGMN,IBMN)
  180. else
  181. IBMN=MIN(IB,IELCHE(/2))
  182. IGMN=MIN(IGAU,IELCHE(/1))
  183. forcf(ma)=DBLE(IELCHE(IGMN,IBMN))
  184. endif
  185. 7071 continue
  186. endif
  187. C
  188. C COMPOSANTES GRADIENTS
  189. if(mkkadz.eq.1) then
  190. do 710 ma=1,mkkad0(/1)
  191. if(mkkad0(ma).eq.0) go to 710
  192. deche =mkkad0(ma)
  193. melval=ABS(ieldec)
  194. if (typree) then
  195. IBMN=MIN(IB,VELCHE(/2))
  196. IGMN=MIN(IGAU,VELCHE(/1))
  197. grad0(ma)=VELCHE(IGMN,IBMN)
  198. else
  199. IBMN=MIN(IB,IELCHE(/2))
  200. IGMN=MIN(IGAU,IELCHE(/1))
  201. grad0(ma)=DBLE(IELCHE(IGMN,IBMN))
  202. endif
  203. 710 continue
  204. do 7101 ma=1,mkkadf(/1)
  205. if(mkkadf(ma).eq.0) go to 7101
  206. deche =mkkadf(ma)
  207. melval=ABS(ieldec)
  208. if (typree) then
  209. IBMN=MIN(IB,VELCHE(/2))
  210. IGMN=MIN(IGAU,VELCHE(/1))
  211. gradf(ma)=VELCHE(IGMN,IBMN)
  212. else
  213. IBMN=MIN(IB,IELCHE(/2))
  214. IGMN=MIN(IGAU,IELCHE(/1))
  215. gradf(ma)=DBLE(IELCHE(IGMN,IBMN))
  216. endif
  217. 7101 continue
  218. endif
  219. C
  220. C COMPOSANTES CONTRAINTES
  221. if(mkkigz.eq.1) then
  222. do 711 ma=1,mkkig0(/1)
  223. if(mkkig0(ma).eq.0) go to 711
  224. deche =mkkig0(ma)
  225. melval=ABS(ieldec)
  226. if (typree) then
  227. IBMN=MIN(IB,VELCHE(/2))
  228. IGMN=MIN(IGAU,VELCHE(/1))
  229. sig0(ma)=VELCHE(IGMN,IBMN)
  230. else
  231. IBMN=MIN(IB,IELCHE(/2))
  232. IGMN=MIN(IGAU,IELCHE(/1))
  233. sig0(ma)=DBLE(IELCHE(IGMN,IBMN))
  234. endif
  235. 711 continue
  236. do 7111 ma=1,mkkigf(/1)
  237. if(mkkigf(ma).eq.0) go to 7111
  238. deche =mkkigf(ma)
  239. melval=ABS(ieldec)
  240. if (typree) then
  241. IBMN=MIN(IB,VELCHE(/2))
  242. IGMN=MIN(IGAU,VELCHE(/1))
  243. sigf(ma)=VELCHE(IGMN,IBMN)
  244. else
  245. IBMN=MIN(IB,IELCHE(/2))
  246. IGMN=MIN(IGAU,IELCHE(/1))
  247. sigf(ma)=DBLE(IELCHE(IGMN,IBMN))
  248. endif
  249. 7111 continue
  250. endif
  251. C
  252. C COMPOSANTES DEFORMATIONS
  253. if(mkkstz.eq.1) then
  254. do 712 ma=1,mkkst0(/1)
  255. if(mkkst0(ma).eq.0) go to 712
  256. deche =mkkst0(ma)
  257. melval=ABS(ieldec)
  258. if (typree) then
  259. IBMN=MIN(IB,VELCHE(/2))
  260. IGMN=MIN(IGAU,VELCHE(/1))
  261. epst0(ma)=VELCHE(IGMN,IBMN)
  262. else
  263. IBMN=MIN(IB,IELCHE(/2))
  264. IGMN=MIN(IGAU,IELCHE(/1))
  265. epst0(ma)=DBLE(IELCHE(IGMN,IBMN))
  266. endif
  267. 712 continue
  268. do 7121 ma=1,mkkstf(/1)
  269. if(mkkstf(ma).eq.0) go to 7121
  270. deche =mkkstf(ma)
  271. melval=ABS(ieldec)
  272. if (typree) then
  273. IBMN=MIN(IB,VELCHE(/2))
  274. IGMN=MIN(IGAU,VELCHE(/1))
  275. epstf(ma)=VELCHE(IGMN,IBMN)
  276. else
  277. IBMN=MIN(IB,IELCHE(/2))
  278. IGMN=MIN(IGAU,IELCHE(/1))
  279. epstf(ma)=DBLE(IELCHE(IGMN,IBMN))
  280. endif
  281. 7121 continue
  282. endif
  283. C
  284. C COMPOSANTES TEMPERATURES
  285. if( mkkrez.eq.1) then
  286. do 715 ma=1,mkkre0(/1)
  287. if(mkkre0(ma).eq.0) go to 715
  288. deche =mkkre0(ma)
  289. melval=ABS(ieldec)
  290. if (typree) then
  291. IBMN=MIN(IB,VELCHE(/2))
  292. IGMN=MIN(IGAU,VELCHE(/1))
  293. ture0(ma)=VELCHE(IGMN,IBMN)
  294. else
  295. IBMN=MIN(IB,IELCHE(/2))
  296. IGMN=MIN(IGAU,IELCHE(/1))
  297. ture0(ma)=DBLE(IELCHE(IGMN,IBMN))
  298. endif
  299. 715 continue
  300. do 7151 ma=1,mkkref(/1)
  301. if(mkkref(ma).eq.0) go to 7151
  302. deche =mkkref(ma)
  303. melval=ABS(ieldec)
  304. if (typree) then
  305. IBMN=MIN(IB,VELCHE(/2))
  306. IGMN=MIN(IGAU,VELCHE(/1))
  307. turef(ma)=VELCHE(IGMN,IBMN)
  308. else
  309. IBMN=MIN(IB,IELCHE(/2))
  310. IGMN=MIN(IGAU,IELCHE(/1))
  311. turef(ma)=DBLE(IELCHE(IGMN,IBMN))
  312. endif
  313. 7151 continue
  314. endif
  315. C
  316. C COMPOSANTES CONTRAINTES PRINCIPALES
  317. if( mkkinz.eq.1) then
  318. do 716 ma=1,mkkin0(/1)
  319. if(mkkin0(ma).eq.0) go to 716
  320. deche =mkkin0(ma)
  321. melval=ABS(ieldec)
  322. if (typree) then
  323. IBMN=MIN(IB,VELCHE(/2))
  324. IGMN=MIN(IGAU,VELCHE(/1))
  325. prin0(ma)=VELCHE(IGMN,IBMN)
  326. else
  327. IBMN=MIN(IB,IELCHE(/2))
  328. IGMN=MIN(IGAU,IELCHE(/1))
  329. prin0(ma)=DBLE(IELCHE(IGMN,IBMN))
  330. endif
  331. 716 continue
  332. do 7161 ma=1,mkkinf(/1)
  333. if(mkkinf(ma).eq.0) go to 7161
  334. deche =mkkinf(ma)
  335. melval=ABS(ieldec)
  336. if (typree) then
  337. IBMN=MIN(IB,VELCHE(/2))
  338. IGMN=MIN(IGAU,VELCHE(/1))
  339. prinf(ma)=VELCHE(IGMN,IBMN)
  340. else
  341. IBMN=MIN(IB,IELCHE(/2))
  342. IGMN=MIN(IGAU,IELCHE(/1))
  343. prinf(ma)=DBLE(IELCHE(IGMN,IBMN))
  344. endif
  345. 7161 continue
  346. endif
  347. C
  348. C COMPOSANTE MAHO
  349. if(mkkhoz.eq.1) then
  350. do 717 ma=1,mkkho0(/1)
  351. if(mkkho0(ma).eq.0) go to 717
  352. deche =mkkho0(ma)
  353. melval=ABS(ieldec)
  354. if (typree) then
  355. IBMN=MIN(IB,VELCHE(/2))
  356. IGMN=MIN(IGAU,VELCHE(/1))
  357. maho0(ma)=VELCHE(IGMN,IBMN)
  358. else
  359. IBMN=MIN(IB,IELCHE(/2))
  360. IGMN=MIN(IGAU,IELCHE(/1))
  361. maho0(ma)=DBLE(IELCHE(IGMN,IBMN))
  362. endif
  363. 717 continue
  364. do 7171 ma=1,mkkhof(/1)
  365. if(mkkhof(ma).eq.0) go to 7171
  366. deche =mkkhof(ma)
  367. melval=ABS(ieldec)
  368. if (typree) then
  369. IBMN=MIN(IB,VELCHE(/2))
  370. IGMN=MIN(IGAU,VELCHE(/1))
  371. mahof(ma)=VELCHE(IGMN,IBMN)
  372. else
  373. IBMN=MIN(IB,IELCHE(/2))
  374. IGMN=MIN(IGAU,IELCHE(/1))
  375. mahof(ma)=DBLE(IELCHE(IGMN,IBMN))
  376. endif
  377. 7171 continue
  378. endif
  379. C
  380. C COMPOSANTE MAHT
  381. if(mkktaz.eq.1) then
  382. do 718 ma=1,mkkta0(/1)
  383. if(mkkta0(ma).eq.0) go to 718
  384. deche =mkkta0(ma)
  385. melval=ABS(ieldec)
  386. if (typree) then
  387. IBMN=MIN(IB,VELCHE(/2))
  388. IGMN=MIN(IGAU,VELCHE(/1))
  389. hota0(ma)=VELCHE(IGMN,IBMN)
  390. else
  391. IBMN=MIN(IB,IELCHE(/2))
  392. IGMN=MIN(IGAU,IELCHE(/1))
  393. hota0(ma)=DBLE(IELCHE(IGMN,IBMN))
  394. endif
  395. 718 continue
  396. do 7181 ma=1,mkktaf(/1)
  397. if(mkktaf(ma).eq.0) go to 7181
  398. deche =mkktaf(ma)
  399. melval=ABS(ieldec)
  400. if (typree) then
  401. IBMN=MIN(IB,VELCHE(/2))
  402. IGMN=MIN(IGAU,VELCHE(/1))
  403. hotaf(ma)=VELCHE(IGMN,IBMN)
  404. else
  405. IBMN=MIN(IB,IELCHE(/2))
  406. IGMN=MIN(IGAU,IELCHE(/1))
  407. hotaf(ma)=DBLE(IELCHE(IGMN,IBMN))
  408. endif
  409. 7181 continue
  410. endif
  411. C
  412. C COMPOSANTES VARIABLES INTERNES
  413. if(mkkvrz.eq.1) then
  414. do 720 ma=1,mkkvr0(/1)
  415. if(mkkvr0(ma).eq.0) go to 720
  416. deche =mkkvr0(ma)
  417. melval=ABS(ieldec)
  418. if (typree) then
  419. IBMN=MIN(IB,VELCHE(/2))
  420. IGMN=MIN(IGAU,VELCHE(/1))
  421. var0(ma)=VELCHE(IGMN,IBMN)
  422. else
  423. IBMN=MIN(IB,IELCHE(/2))
  424. IGMN=MIN(IGAU,IELCHE(/1))
  425. var0(ma)=DBLE(IELCHE(IGMN,IBMN))
  426. endif
  427. 720 continue
  428. do 7201 ma=1,mkkvrf(/1)
  429. if(mkkvrf(ma).eq.0) go to 7201
  430. deche =mkkvrf(ma)
  431. melval=ABS(ieldec)
  432. if (typree) then
  433. IBMN=MIN(IB,VELCHE(/2))
  434. IGMN=MIN(IGAU,VELCHE(/1))
  435. varf(ma)=VELCHE(IGMN,IBMN)
  436. else
  437. IBMN=MIN(IB,IELCHE(/2))
  438. IGMN=MIN(IGAU,IELCHE(/1))
  439. varf(ma)=DBLE(IELCHE(IGMN,IBMN))
  440. endif
  441. 7201 continue
  442. endif
  443. C
  444. C COMPOSANTES GRADIENTS FLEXION
  445. if( mkkafz.eq.1) then
  446. do 721 ma=1,mkkaf0(/1)
  447. if(mkkaf0(ma).eq.0) go to 721
  448. deche =mkkaf0(ma)
  449. melval=ABS(ieldec)
  450. if (typree) then
  451. IBMN=MIN(IB,VELCHE(/2))
  452. IGMN=MIN(IGAU,VELCHE(/1))
  453. graf0(ma)=VELCHE(IGMN,IBMN)
  454. else
  455. IBMN=MIN(IB,IELCHE(/2))
  456. IGMN=MIN(IGAU,IELCHE(/1))
  457. graf0(ma)=DBLE(IELCHE(IGMN,IBMN))
  458. endif
  459. 721 continue
  460. do 7211 ma=1,mkkaff(/1)
  461. if(mkkaff(ma).eq.0) go to 7211
  462. deche =mkkaff(ma)
  463. melval=ABS(ieldec)
  464. if (typree) then
  465. IBMN=MIN(IB,VELCHE(/2))
  466. IGMN=MIN(IGAU,VELCHE(/1))
  467. graff(ma)=VELCHE(IGMN,IBMN)
  468. else
  469. IBMN=MIN(IB,IELCHE(/2))
  470. IGMN=MIN(IGAU,IELCHE(/1))
  471. graff(ma)=DBLE(IELCHE(IGMN,IBMN))
  472. endif
  473. 7211 continue
  474. endif
  475. C
  476. C COMPOSANTES VARIABLES MICROSTRUCTURES
  477. if(mkkasz.eq.1) then
  478. do 723 ma=1,mkkas0(/1)
  479. if(mkkas0(ma).eq.0) go to 723
  480. deche =mkkas0(ma)
  481. melval=ABS(ieldec)
  482. if (typree) then
  483. IBMN=MIN(IB,VELCHE(/2))
  484. IGMN=MIN(IGAU,VELCHE(/1))
  485. rhas0(ma)=VELCHE(IGMN,IBMN)
  486. else
  487. IBMN=MIN(IB,IELCHE(/2))
  488. IGMN=MIN(IGAU,IELCHE(/1))
  489. rhas0(ma)=DBLE(IELCHE(IGMN,IBMN))
  490. endif
  491. 723 continue
  492. do 7231 ma=1,mkkasf(/1)
  493. if(mkkasf(ma).eq.0) go to 7231
  494. deche =mkkasf(ma)
  495. melval=ABS(ieldec)
  496. if (typree) then
  497. IBMN=MIN(IB,VELCHE(/2))
  498. IGMN=MIN(IGAU,VELCHE(/1))
  499. rhasf(ma)=VELCHE(IGMN,IBMN)
  500. else
  501. IBMN=MIN(IB,IELCHE(/2))
  502. IGMN=MIN(IGAU,IELCHE(/1))
  503. rhasf(ma)=DBLE(IELCHE(IGMN,IBMN))
  504. endif
  505. 7231 continue
  506. endif
  507. C
  508. C COMPOSANTES DEFORMATIONS INELASTIQUES
  509. if(mkkpnz.eq.1) then
  510. do 724 ma=1,mkkpn0(/1)
  511. if(mkkpn0(ma).eq.0) go to 724
  512. deche =mkkpn0(ma)
  513. melval=ABS(ieldec)
  514. if (typree) then
  515. IBMN=MIN(IB,VELCHE(/2))
  516. IGMN=MIN(IGAU,VELCHE(/1))
  517. epin0(ma)=VELCHE(IGMN,IBMN)
  518. else
  519. IBMN=MIN(IB,IELCHE(/2))
  520. IGMN=MIN(IGAU,IELCHE(/1))
  521. epin0(ma)=DBLE(IELCHE(IGMN,IBMN))
  522. endif
  523. 724 continue
  524. do 7241 ma=1,mkkpnf(/1)
  525. if(mkkpnf(ma).eq.0) go to 7241
  526. deche =mkkpnf(ma)
  527. melval=ABS(ieldec)
  528. if (typree) then
  529. IBMN=MIN(IB,VELCHE(/2))
  530. IGMN=MIN(IGAU,VELCHE(/1))
  531. epinf(ma)=VELCHE(IGMN,IBMN)
  532. else
  533. IBMN=MIN(IB,IELCHE(/2))
  534. IGMN=MIN(IGAU,IELCHE(/1))
  535. epinf(ma)=DBLE(IELCHE(IGMN,IBMN))
  536. endif
  537. 7241 continue
  538. endif
  539. C-
  540. if (mkkexz.eq.1) then
  541. do 725 ma=1,mkkex0(/1)
  542. if(mkkex0(ma).eq.0) go to 725
  543. deche =mkkex0(ma)
  544. melval=ABS(ieldec)
  545. if (typree) then
  546. IBMN=MIN(IB,VELCHE(/2))
  547. IGMN=MIN(IGAU,VELCHE(/1))
  548. parex0(ma)=VELCHE(IGMN,IBMN)
  549. else
  550. IBMN=MIN(IB,IELCHE(/2))
  551. IGMN=MIN(IGAU,IELCHE(/1))
  552. parex0(ma)=DBLE(IELCHE(IGMN,IBMN))
  553. endif
  554. 725 continue
  555. do 7251 ma=1,mkkexf(/1)
  556. if(mkkexf(ma).eq.0) go to 7251
  557. deche =mkkexf(ma)
  558. melval=ABS(ieldec)
  559. if (typree) then
  560. IBMN=MIN(IB,VELCHE(/2))
  561. IGMN=MIN(IGAU,VELCHE(/1))
  562. parexf(ma)=VELCHE(IGMN,IBMN)
  563. else
  564. IBMN=MIN(IB,IELCHE(/2))
  565. IGMN=MIN(IGAU,IELCHE(/1))
  566. parexf(ma)=DBLE(IELCHE(IGMN,IBMN))
  567. endif
  568. 7251 continue
  569. endif
  570. C-
  571. if(mkkvxz.eq.1) then
  572. do 726 ma=1,mkkvx0(/1)
  573. if(mkkvx0(ma).eq.0) go to 726
  574. deche =mkkvx0(ma)
  575. melval=ABS(ieldec)
  576. if (typree) then
  577. IBMN=MIN(IB,VELCHE(/2))
  578. IGMN=MIN(IGAU,VELCHE(/1))
  579. exova0(ma)=VELCHE(IGMN,IBMN)
  580. else
  581. IBMN=MIN(IB,IELCHE(/2))
  582. IGMN=MIN(IGAU,IELCHE(/1))
  583. exova0(ma)=DBLE(IELCHE(IGMN,IBMN))
  584. endif
  585. 726 continue
  586. do 7261 ma=1,mkkvx1(/1)
  587. if(mkkvx1(ma).eq.0) go to 7261
  588. deche =mkkvx1(ma)
  589. melval=ABS(ieldec)
  590. if (typree) then
  591. IBMN=MIN(IB,VELCHE(/2))
  592. IGMN=MIN(IGAU,VELCHE(/1))
  593. exova1(ma)=VELCHE(IGMN,IBMN)
  594. else
  595. IBMN=MIN(IB,IELCHE(/2))
  596. IGMN=MIN(IGAU,IELCHE(/1))
  597. exova1(ma)=DBLE(IELCHE(IGMN,IBMN))
  598. endif
  599. 7261 continue
  600. endif
  601. C-
  602. endif
  603. C =================================================================
  604. C =================================================================
  605. if( ib+IGAu.eq.2) THEN
  606. idepup=1
  607. ifinup=nbluc1
  608. else
  609. idepup=13
  610. ifinup=14
  611. endif
  612. C
  613. C -------------------------------------------
  614. C Boucle (1000) sur les composantes a traiter
  615. C -------------------------------------------
  616. DO 1000 INO = IDEPUP,IFINUP
  617. C
  618. nomid = liluc(ino,1)
  619. pilnec = liluc(ino,2)
  620. if (pilnec.le.0) goto 1000
  621. C
  622. mran = pilobl(/2)
  623. mobl = pilobl(/1)
  624. mfac = pilfac(/1)
  625. if (mran.le.0) goto 1000
  626. C
  627. DO 3000 IR = 1,MRAN
  628. C
  629. C ++++++++++++++++++++++++
  630. C COMPOSANTES OBLIGATOIRES
  631. C ++++++++++++++++++++++++
  632. if (mobl.le.0) goto 101
  633. DO 100 IC = 1,MOBL
  634. passe1= 0.d0
  635. ipilo1 = pilobl(ic,ir)
  636. * attention les valeurs induites par deche (nomdec, typdec)ne sont pas effacees
  637. if (pilobl(ic,ir).gt.0) then
  638. deche = pilobl(ic,ir)
  639. * on evite les deche crees pour le modele
  640. * write(6,*) ino,ir,ic,deche,nomdec,typdec,condec
  641. if (ir.eq.indeso.and.condec(1:24).eq.conmod(1:24))goto 100
  642. melval = ABS(ieldec)
  643. if (typree) then
  644. IBMN=MIN(IB,VELCHE(/2))
  645. IGMN=MIN(IGAU,VELCHE(/1))
  646. passe1=VELCHE(IGMN,IBMN)
  647. else
  648. IBMN=MIN(IB,IELCHE(/2))
  649. IGMN=MIN(IGAU,IELCHE(/1))
  650. passe1=DBLE(IELCHE(IGMN,IBMN))
  651. endif
  652. endif
  653. C
  654. C AIGUILLAGE SUIVANT MOT CLE
  655. C
  656. if (ino.gt.nmot) goto 98
  657. GOTO ( 1, 2, 99, 99, 99, 6, 7,99,99,10,11,12,13,14,15,16, 17,18,
  658. & 99,20,21,99,23,24,25) ino
  659. C
  660. 99 CONTINUE
  661. C
  662. C PAS DE COMPOSANTES POUR CE CHAMP
  663. RETURN
  664. C
  665. C COMPOSANTE SCAL
  666. 1 CONTINUE
  667. if (ipilo1.le.0) goto 100
  668. if (ir.eq.1) then
  669. scal0(ic) = passe1
  670. mkkal0(ic)=deche
  671. else if (ir.ge.(mran -1)) then
  672. scalf(ic) = passe1
  673. mkklaf(ic)=deche
  674. endif
  675. if(deche.ne.0) mkkalz=1
  676. GOTO 120
  677. C
  678. C COMPOSANTE TEMP
  679. 2 CONTINUE
  680. if (ipilo1.le.0) goto 100
  681. if (ir.eq.1) then
  682. temp0 = passe1
  683. mkktp0=deche
  684. else if (ir.ge.(mran -1)) then
  685. tempf = passe1
  686. mkktpf=deche
  687. endif
  688. GOTO 120
  689. C
  690. C COMPOSANTES PRIMALES
  691. 6 CONTINUE
  692. if (ipilo1.le.0) goto 100
  693. if (ir.eq.1) then
  694. depl0(ic) = passe1
  695. mkkpl0(ic)=deche
  696. else if (ir.ge.(mran -1)) then
  697. deplf(ic) = passe1
  698. mkkplf(ic)=deche
  699. endif
  700. if(deche.ne.0) mkkplz=1
  701. GOTO 120
  702. C
  703. C COMPOSANTES DUALES
  704. 7 CONTINUE
  705. if (ipilo1.le.0) goto 100
  706. if (ir.eq.1) then
  707. forc0(ic) = passe1
  708. mkkrc0(ic)=deche
  709. else if (ir.ge.(mran -1)) then
  710. forcf(ic) = passe1
  711. mkkrcf(ic)=deche
  712. endif
  713. if(deche.ne.0) mkkrcz=1
  714. GOTO 120
  715. C
  716. C COMPOSANTES GRADIENTS
  717. 10 CONTINUE
  718. if (ipilo1.le.0) goto 100
  719. if (ir.eq.1) then
  720. grad0(ic) = passe1
  721. mkkad0(ic)=deche
  722. else if (ir.ge.(mran -1)) then
  723. gradf(ic) = passe1
  724. mkkadf(ic)=deche
  725. endif
  726. if(deche.ne.0) mkkadz=1
  727. GOTO 120
  728. C
  729. C COMPOSANTES CONTRAINTES
  730. 11 CONTINUE
  731. if (ipilo1.le.0) goto 100
  732. if (ir.eq.1) then
  733. SIG0(ic) = passe1
  734. mkkig0(ic)=deche
  735. else if (ir.ge.(mran -1)) then
  736. SIGF(ic) = passe1
  737. mkkigf(ic)=deche
  738. endif
  739. if(deche.ne.0) mkkigz=1
  740. GOTO 120
  741. C
  742. C COMPOSANTES DEFORMATIONS
  743. 12 CONTINUE
  744. if (ipilo1.le.0) goto 100
  745. if (ir.eq.1) then
  746. epst0(ic) = passe1
  747. mkkst0(ic) =deche
  748. else if (ir.gt.1.and.ir.le.mran) then
  749. epstf(ic) = passe1
  750. mkkstf(ic) = deche
  751. endif
  752. if(deche.ne.0) mkkstz=1
  753. GOTO 120
  754. C
  755. C COMPOSANTES MATERIAUX
  756. 13 CONTINUE
  757. if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  758. commat(ic) = lesobl(ic)
  759. tyval(ic) = 'REAL*8 '
  760. endif
  761. if (ir.gt.1) then
  762. ivalma(ic) = 0
  763. if (ipilo1.gt.0) ivalma(ic) = ABS(ieldec)
  764. endif
  765. if (ipilo1.le.0) goto 100
  766. if (ir.eq.1) then
  767. valma0(ic) = passe1
  768. mkkva0(ic)=deche
  769. elseif (ir.gt.1.and.ir.le.(mran -1)) then
  770. VALMAT(ic) = passe1
  771. mkkvat(ic)=deche
  772. if (deche.eq.0) then
  773. call erreur(1073)
  774. return
  775. endif
  776. tyval (ic)= typdec
  777. xmatf(ic) = passe1
  778. mkkatf(ic)=deche
  779. else if (ir.eq.mran ) then
  780. xmatf(ic) = passe1
  781. mkkatf(ic)=deche
  782. endif
  783. if (igau.eq.1.and.ib.eq.1) then
  784. IF (CMATE.EQ.'SECTION ') THEN
  785. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  786. N2EL =MAX(N2EL ,IELCHE(/2))
  787. ELSE
  788. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  789. N2EL =MAX(N2EL ,VELCHE(/2))
  790. ENDIF
  791. endif
  792. GOTO 120
  793. C
  794. C COMPOSANTES CARACTERISTIQUES
  795. 14 CONTINUE
  796. if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  797. comcar(ic) = lesobl(ic)
  798. tycar(ic) = 'REAL*8 '
  799. endif
  800. mblcar=mobl
  801. if (ipilo1.le.0.and.mfr.ne.9.and.mfr.ne.3) goto 100
  802. if (ir.eq.1) then
  803. xcar0(ic) = passe1
  804. mkkar0(ic)=deche
  805. elseif (ir.gt.1.and.ir.le.(mran-1)) then
  806. if (deche.eq.0) then
  807. call erreur(1073)
  808. return
  809. endif
  810. tycar(ic) = typdec
  811. XCARB(ic) = passe1
  812. mkkarb(ic)=deche
  813. xcarbf(ic) = passe1
  814. mkkrbf(ic)=deche
  815. *
  816. * tuyaux
  817. *
  818. IF (mfr.eq.13) THEN
  819. C
  820. C Poutre 3D
  821. C
  822. ELSE IF(mfr.EQ.7.AND.IDIM.EQ.3)THEN
  823. C
  824. C Poutre 2D
  825. C
  826. ELSEIF(IDIM.EQ.2) THEN
  827. if (ipilo1.le.0.and.ic.eq.2) then
  828. IF(mfr.EQ.3.OR.mfr.EQ.9) THEN
  829. XCARB(IC)=0.66666666666666D0
  830. ENDIF
  831. endif
  832. ELSE
  833. * cas des coques minces : défaut de alfah
  834. IF (ipilo1.le.0.and.IC.EQ.2.AND.
  835. & (mfr.EQ.3.OR.mfr.EQ.9)) THEN
  836. XCARB(IC)=0.666666666666666D0
  837. ENDIF
  838. C
  839. ENDIF
  840.  
  841. else if (ir.eq.mran) then
  842. xcarbf(ic) = passe1
  843. mkkrbf(ic)=deche
  844. endif
  845. if(deche.ne.0) mkkarz=1
  846. GOTO 120
  847. C
  848. C COMPOSANTES TEMPERATURES
  849. 15 CONTINUE
  850. if (ipilo1.le.0) goto 100
  851. if (ir.eq.1) then
  852. ture0(ic) = passe1
  853. mkkre0(ic)=deche
  854. else if (ir.ge.(mran -1)) then
  855. turef(ic) = passe1
  856. mkkref(ic)=deche
  857. endif
  858. if(deche.ne.0) mkkrez=1
  859. GOTO 120
  860. C
  861. C COMPOSANTES CONTRAINTES PRINCIPALES
  862. 16 CONTINUE
  863. if (ipilo1.le.0) goto 100
  864. if (ir.eq.1) then
  865. prin0(ic) = passe1
  866. mkkin0(ic)=deche
  867. else if (ir.ge.(mran -1)) then
  868. prinf(ic) = passe1
  869. mkkinf(ic)=deche
  870. endif
  871. if(deche.ne.0) mkkinz=1
  872. GOTO 120
  873. C
  874. C COMPOSANTE MAHO
  875. 17 CONTINUE
  876. if (ipilo1.le.0) goto 100
  877. if (ir.eq.1) then
  878. maho0(ic) = passe1
  879. mkkho0(ic)=deche
  880. else if (ir.ge.(mran -1)) then
  881. mahof(ic) = passe1
  882. mkkhof(ic)=deche
  883. endif
  884. if(deche.ne.0) mkkhoz=1
  885. GOTO 120
  886. C
  887. C COMPOSANTE MAHT
  888. 18 CONTINUE
  889. if (ipilo1.le.0) goto 100
  890. if (ir.eq.1) then
  891. hota0(ic) = passe1
  892. mkkta0(ic)=deche
  893. else if (ir.ge.(mran -1)) then
  894. hotaf(ic) = passe1
  895. mkktaf(ic)=deche
  896. endif
  897. if(deche.ne.0) mkktaz=1
  898. GOTO 120
  899. C
  900. C COMPOSANTES VARIABLES INTERNES
  901. 20 CONTINUE
  902. if (ipilo1.le.0) goto 100
  903. if (ir.eq.1) then
  904. VAR0(ic) = passe1
  905. * write(6,*) 'var0 ', passe1
  906. mkkvr0(ic)=deche
  907. else if (ir.ge.(mran -1)) then
  908. VARF(ic) = passe1
  909. mkkvrf(ic)=deche
  910. endif
  911. if(deche.ne.0) mkkvrz=1
  912. GOTO 120
  913. C
  914. C COMPOSANTES GRADIENTS FLEXION
  915. 21 CONTINUE
  916. if (ipilo1.le.0) goto 100
  917. if (ir.eq.1) then
  918. graf0(ic) = passe1
  919. mkkaf0(ic)=deche
  920. else if (ir.ge.(mran -1)) then
  921. graff(ic) = passe1
  922. mkkaff(ic)=deche
  923. endif
  924. if(deche.ne.0) mkkafz=1
  925. GOTO 120
  926. C
  927. C COMPOSANTES VARIABLES MICROSTRUCTURES
  928. 23 CONTINUE
  929. if (ipilo1.le.0) goto 100
  930. if (ir.eq.1) then
  931. rhas0(ic) = passe1
  932. mkkas0(ic)=deche
  933. else if (ir.ge.(mran -1)) then
  934. rhasf(ic) = passe1
  935. mkkasf(ic)=deche
  936. endif
  937. if(deche.ne.0) mkkasz=1
  938. GOTO 120
  939. C
  940. C COMPOSANTES DEFORMATIONS INELASTIQUES
  941. 24 CONTINUE
  942. if (ipilo1.le.0) goto 100
  943. if (ir.eq.1) then
  944. EPIN0(ic) = passe1
  945. mkkpn0(ic)=deche
  946. else if (ir.ge.(mran -1)) then
  947. EPINF(ic) = passe1
  948. mkkpnf(ic)=deche
  949. endif
  950. if(deche.ne.0) mkkpnz=1
  951. GOTO 120
  952. C
  953. 25 CONTINUE
  954. if (ipilo1.le.0) goto 100
  955. if (ir.eq.1) then
  956. PAREX0(ic) = passe1
  957. mkkex0(ic)=deche
  958. else if (ir.ge.(mran -1)) then
  959. PAREXF(ic) = passe1
  960. mkkexf(ic)=deche
  961. endif
  962. if(deche.ne.0) mkkexz=1
  963. GOTO 120
  964. C
  965. 98 CONTINUE
  966. if (ipilo1.le.0) goto 100
  967. if (ir.eq.1) then
  968. exova0(ic) = passe1
  969. mkkvx0(ic)=deche
  970. else if (ir.ge.(mran -1)) then
  971. exova1(ic) = passe1
  972. mkkvx1(ic)=deche
  973. endif
  974. if (nomexo(ic).eq.'STEP ') istep = int(exova0(ic))
  975. if(deche.ne.0) mkkvxz=1
  976. GOTO 120
  977. C
  978. 120 CONTINUE
  979. 100 CONTINUE
  980. C
  981. 101 CONTINUE
  982. C
  983. C ++++++++++++++++++++++++
  984. C COMPOSANTES FACULTATIVES
  985. C ++++++++++++++++++++++++
  986. C if (mfac.le.0) goto 301
  987. DO 200 IC = 1,MFAC
  988. passe1= 0.d0
  989. ipilo2 = pilfac(ic,ir)
  990. if (pilfac(ic,ir).gt.0) then
  991. deche = pilfac(ic,ir)
  992. * on evite les deche crees pour le modele
  993. * if (ib.eq.1.and.igau.eq.1)
  994. * & write(6,*) ino,ir,ic,deche,nomdec,typdec,condec
  995. if (ir.eq.indeso.and.condec(1:24).eq.conmod(1:24))goto 200
  996. melval = ABS(ieldec)
  997. c segact melval
  998. if (typree) then
  999. IBMN=MIN(IB,VELCHE(/2))
  1000. IGMN=MIN(IGAU,VELCHE(/1))
  1001. passe1=VELCHE(IGMN,IBMN)
  1002. else
  1003. IBMN=MIN(IB,IELCHE(/2))
  1004. IGMN=MIN(IGAU,IELCHE(/1))
  1005. passe1=DBLE(IELCHE(IGMN,IBMN))
  1006. endif
  1007. endif
  1008. C
  1009. C AIGUILLAGE SUIVANT MOT CLE
  1010. C
  1011. if (ino.gt.nmot) goto 298
  1012. GOTO ( 201,202,299,299,299,206, 207,299,299,210,211,
  1013. & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  1014. *
  1015. 299 CONTINUE
  1016. C
  1017. C PAS DE COMPOSANTES POUR CE CHAMP
  1018. RETURN
  1019. C
  1020. C COMPOSANTE SCAL
  1021. 201 CONTINUE
  1022. if (ipilo2.le.0) goto 200
  1023. if (ir.eq.1) then
  1024. scal0(mobl+ic) = passe1
  1025. mkkal0(ic+mobl)=deche
  1026. else if (ir.ge.(mran -1)) then
  1027. scalf(mobl+ic) = passe1
  1028. mkklaf(ic+mobl)=deche
  1029. endif
  1030. if(deche.ne.0) mkkalz=1
  1031. GOTO 320
  1032. C
  1033. C COMPOSANTE TEMP
  1034. 202 CONTINUE
  1035. if (ipilo2.le.0) goto 200
  1036. * bizarre de passer la ...
  1037. GOTO 320
  1038. C
  1039. C COMPOSANTES PRIMALES
  1040. 206 CONTINUE
  1041. if (ipilo2.le.0) goto 200
  1042. if (ir.eq.1) then
  1043. depl0(mobl+ic) = passe1
  1044. mkkpl0(ic+mobl)=deche
  1045. else if (ir.ge.(mran -1)) then
  1046. deplf(mobl+ic) = passe1
  1047. mkkplf(ic+mobl)=deche
  1048. endif
  1049. if(deche.ne.0) mkkplz=1
  1050. GOTO 320
  1051. C
  1052. C COMPOSANTES DUALES
  1053. 207 CONTINUE
  1054. if (ipilo2.le.0) goto 200
  1055. if (ir.eq.1) then
  1056. forc0(mobl+ic) = passe1
  1057. mkkrc0(ic+mobl)=deche
  1058. else if (ir.ge.(mran -1)) then
  1059. forcf(mobl+ic) = passe1
  1060. mkkrcf(ic+mobl)=deche
  1061. endif
  1062. if(deche.ne.0) mkkrcz=1
  1063. GOTO 320
  1064. C
  1065. C COMPOSANTES GRADIENTS
  1066. 210 CONTINUE
  1067. if (ipilo2.le.0) goto 200
  1068. if (ir.eq.1) then
  1069. grad0(mobl+ic) = passe1
  1070. mkkad0(ic+mobl)=deche
  1071. else if (ir.ge.(mran -1)) then
  1072. gradf(mobl+ic) = passe1
  1073. mkkadf(ic+mobl)=deche
  1074. endif
  1075. if(deche.ne.0) mkkadz=1
  1076. GOTO 320
  1077. C
  1078. C COMPOSANTES CONTRAINTES
  1079. 211 CONTINUE
  1080. if (ipilo2.le.0) goto 200
  1081. if (ir.eq.1) then
  1082. SIG0(mobl+ic) = passe1
  1083. mkkig0(ic+mobl)=deche
  1084. else if (ir.ge.(mran -1)) then
  1085. SIGF(mobl+ic) = passe1
  1086. mkkigf(ic+mobl)=deche
  1087. endif
  1088. if(deche.ne.0) mkkigz=1
  1089. GOTO 320
  1090. C
  1091. C COMPOSANTES DEFORMATIONS
  1092. 212 CONTINUE
  1093. if (ipilo2.le.0) goto 200
  1094. if (ir.eq.1) then
  1095. epst0(mobl+ic) = passe1
  1096. mkkst0(ic+mobl) =deche
  1097. else if (ir.gt.1.and.ir.le.mran) then
  1098. epstf(mobl+ic) = passe1
  1099. mkkstf(ic+mobl) = deche
  1100. endif
  1101. if(deche.ne.0) mkkstz=1
  1102. GOTO 320
  1103. C
  1104. C COMPOSANTES MATERIAUX
  1105. 213 CONTINUE
  1106. if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  1107. commat(mobl+ic) = lesfac(ic)
  1108. tyval(mobl+ic) = 'REAL*8 '
  1109. endif
  1110. if (ir.gt.1) then
  1111. ivalma(mobl+ic) = 0
  1112. if (ipilo2.gt.0) ivalma(mobl+ic) = ABS(ieldec)
  1113. endif
  1114. if (ipilo2.le.0) goto 200
  1115. if (ir.eq.1) then
  1116. valma0(mobl+ic) = passe1
  1117. mkkva0(ic+mobl)=deche
  1118. elseif (ir.gt.1.and.ir.le.(mran - 1)) then
  1119. VALMAT(mobl+ic) = passe1
  1120. mkkvat(ic+mobl)=deche
  1121. if (deche.eq.0) then
  1122. call erreur(1073)
  1123. return
  1124. endif
  1125. tyval(mobl+ic) = typdec
  1126. xmatf(mobl+ic) = passe1
  1127. mkkatf(ic+mobl)=deche
  1128. if ((inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142)
  1129. & .and.nomdec(1:4).eq.'ALPH') then
  1130. ** if (typdec(1:8).eq.'REAL*8 '.or.typdec(1:8).eq.'POINTEUR')
  1131. if (typree .or.typdec(1:8).eq.'POINTEUR')
  1132. & ITHHER=1
  1133. endif
  1134. else if (ir.eq.mran) then
  1135. xmatf(mobl+ic) = passe1
  1136. mkkatf(ic+mobl)=deche
  1137. endif
  1138. C
  1139. if (igau.eq.1.and.ib.eq.1) then
  1140. IF (CMATE.EQ.'SECTION ') THEN
  1141. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  1142. N2EL =MAX(N2EL ,IELCHE(/2))
  1143. ELSE
  1144. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  1145. N2EL =MAX(N2EL ,VELCHE(/2))
  1146. ENDIF
  1147. endif
  1148. GOTO 320
  1149. C
  1150. C COMPOSANTES CARACTERISTIQUES
  1151. 214 CONTINUE
  1152. if (ib.eq.1.and.igau.eq.1.and.ir.eq.1) then
  1153. comcar(mobl+ic)=lesfac(ic)
  1154. tycar(mobl+ic)='REAL*8 '
  1155. endif
  1156. if (ipilo2.le.0.and.mfr.ne.9.and.mfr.ne.3) goto 200
  1157. if (ir.eq.1) then
  1158. xcar0(mobl+ic) = passe1
  1159. mkkar0(ic+mobl)=deche
  1160. else if (ir.gt.1.and.ir.le.(mran -1)) then
  1161. XCARB(mobl+ic) = passe1
  1162. mkkarb(ic+mobl)=deche
  1163. xcarbf(mobl+ic) = passe1
  1164. if (deche.eq.0) then
  1165. call erreur(1073)
  1166. return
  1167. endif
  1168. tycar(mobl+ic) = typdec
  1169. *
  1170. * tuyaux
  1171. *
  1172. IF (mfr.eq.13) THEN
  1173. * composante VECT
  1174. if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT ') then
  1175. ip = int(passe1)
  1176. mkkarb(ic+mobl)=deche
  1177. IREF=(IP-1)*(IDIM+1)
  1178. * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR
  1179. DO 3208 IC2=1,IDIM
  1180. XCARB(ncarr+IC2)=XCOOR(IREF+IC2)
  1181. 3208 continue
  1182. else
  1183. DO 3209 IC2=1,IDIM
  1184. XCARB(ncarr+IC2)=0.d0
  1185. 3209 continue
  1186. endif
  1187. C
  1188. C Poutre 3D
  1189. C
  1190. ELSE IF(mfr.EQ.7.AND.IDIM.EQ.3)THEN
  1191. * composante VECT
  1192. if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT ') then
  1193. IP=int(passe1)
  1194. mkkarb(ic+mobl)=deche
  1195. IREF=(IP-1)*(IDIM+1)
  1196. * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR
  1197. DO 4208 IC2=1,IDIM
  1198. XCARB(ncarr+IC2)=XCOOR(IREF+IC2)
  1199. 4208 continue
  1200. else
  1201. DO 4209 IC2=1,IDIM
  1202. XCARB(ncarr+IC2)=0.D0
  1203. 4209 continue
  1204. endif
  1205. C
  1206. C Poutre 2D
  1207. C
  1208. ELSEIF(IDIM.EQ.2) THEN
  1209. if (ipilo2.le.0.and.mobl+ic.eq.2) then
  1210. IF(mfr.EQ.3.OR.mfr.EQ.9) THEN
  1211. XCARB(mobl+IC)=0.66666666666666D0
  1212. ENDIF
  1213. endif
  1214. ELSE
  1215. * cas des coques minces : défaut de alfah
  1216. IF (ipilo2.le.0.and.mobl+IC.EQ.2.AND.
  1217. & (mfr.EQ.3.OR.mfr.EQ.9)) THEN
  1218. XCARB(mobl+IC)=0.666666666666666D0
  1219. ENDIF
  1220. ENDIF
  1221. else if (ir.ge.mran) then
  1222. xcarbf(mobl+ic) = passe1
  1223. mkkrbf(ic+mobl)=deche
  1224. endif
  1225. if(deche.ne.0) mkkarz=1
  1226. GOTO 320
  1227. C
  1228. C COMPOSANTES TEMPERATURES
  1229. 215 CONTINUE
  1230. if (ipilo2.le.0) goto 200
  1231. if (ir.eq.1) then
  1232. ture0(mobl+ic) = passe1
  1233. mkkre0(ic+mobl)=deche
  1234. else if (ir.ge.(mran -1)) then
  1235. turef(mobl+ic) = passe1
  1236. mkkref(ic+mobl)=deche
  1237. endif
  1238. if(deche.ne.0) mkkrez=1
  1239. GOTO 320
  1240. C
  1241. C COMPOSANTES CONTRAINTES PRINCIPALES
  1242. 216 CONTINUE
  1243. if (ipilo2.le.0) goto 200
  1244. if (ir.eq.1) then
  1245. prin0(mobl+ic) = passe1
  1246. mkkin0(ic+mobl)=deche
  1247. else if (ir.ge.(mran -1)) then
  1248. prinf(mobl+ic) = passe1
  1249. mkkinf(ic+mobl)=deche
  1250. endif
  1251. if(deche.ne.0) mkkinz=1
  1252. GOTO 320
  1253. C
  1254. C COMPOSANTE MAHO
  1255. 217 CONTINUE
  1256. if (ipilo2.le.0) goto 200
  1257. if (ir.eq.1) then
  1258. maho0(mobl+ic) = passe1
  1259. mkkho0(ic+mobl)=deche
  1260. else if (ir.ge.(mran -1)) then
  1261. mahof(mobl+ic) = passe1
  1262. mkkhof(ic+mobl)=deche
  1263. endif
  1264. if(deche.ne.0) mkkhoz=1
  1265. GOTO 320
  1266. C
  1267. C COMPOSANTE MAHT
  1268. 218 CONTINUE
  1269. if (ipilo2.le.0) goto 200
  1270. if (ir.eq.1) then
  1271. hota0(mobl+ic) = passe1
  1272. mkkta0(ic+mobl)=deche
  1273. else if (ir.ge.(mran -1)) then
  1274. hotaf(mobl+ic) = passe1
  1275. mkktaf(ic+mobl)=deche
  1276. endif
  1277. if(deche.ne.0) mkktaz=1
  1278. GOTO 320
  1279. C
  1280. C COMPOSANTES VARIABLES INTERNES
  1281. 220 CONTINUE
  1282. if (ipilo2.le.0) goto 200
  1283. if (ir.eq.1) then
  1284. VAR0(mobl+ic) = passe1
  1285. mkkvr0(ic+mobl)=deche
  1286. else if (ir.ge.(mran -1)) then
  1287. VARF(mobl+ic) = passe1
  1288. mkkvrf(ic+mobl)=deche
  1289. endif
  1290. if(deche.ne.0) mkkvrz=1
  1291. GOTO 320
  1292. C
  1293. C COMPOSANTES GRADIENTS FLEXION
  1294. 221 CONTINUE
  1295. if (ipilo2.le.0) goto 200
  1296. if (ir.eq.1) then
  1297. graf0(mobl+ic) = passe1
  1298. mkkaf0(ic+mobl)=deche
  1299. else if (ir.ge.(mran -1)) then
  1300. graff(mobl+ic) = passe1
  1301. mkkaff(ic+mobl)=deche
  1302. endif
  1303. if(deche.ne.0) mkkafz=1
  1304. GOTO 320
  1305. C
  1306. C COMPOSANTES VARIABLES MICROSTRUCTURES
  1307. 223 CONTINUE
  1308. if (ipilo2.le.0) goto 200
  1309. if (ir.eq.1) then
  1310. rhas0(mobl+ic) = passe1
  1311. mkkas0(ic+mobl)=deche
  1312. else if (ir.ge.(mran -1)) then
  1313. rhasf(mobl+ic) = passe1
  1314. mkkasf(ic+mobl)=deche
  1315. endif
  1316. if(deche.ne.0) mkkasz=1
  1317. GOTO 320
  1318. C
  1319. C COMPOSANTES DEFORMATIONS INELASTIQUES
  1320. 224 CONTINUE
  1321. if (ipilo2.le.0) goto 200
  1322. if (ir.eq.1) then
  1323. EPIN0(mobl+ic) = passe1
  1324. mkkpn0(ic+mobl)=deche
  1325. else if (ir.ge.(mran -1)) then
  1326. EPINF(mobl+ic) = passe1
  1327. mkkpnf(ic+mobl)=deche
  1328. endif
  1329. if(deche.ne.0) mkkpnz=1
  1330. GOTO 320
  1331. C
  1332. 298 CONTINUE
  1333. if (ipilo2.le.0) goto 200
  1334. exova0(mobl + ic) = passe1
  1335. mkkvx0(ic+mobl)=deche
  1336. if(deche.ne.0) mkkvxz=1
  1337. GOTO 320
  1338. C
  1339. 320 CONTINUE
  1340. 200 CONTINUE
  1341. C
  1342. 301 CONTINUE
  1343. C
  1344. 3000 CONTINUE
  1345. 1000 CONTINUE
  1346. C ------------------------------------------------------------
  1347. C
  1348. IF (IGAU.EQ.1.AND.IB.EQ.1) THEN
  1349. IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN
  1350. N2PTEL=1
  1351. ELSE
  1352. N2PTEL=NBG
  1353. ENDIF
  1354. ENDIF
  1355. C
  1356. C Increment de deformations
  1357. DO IG = 1, DEPST(/1)
  1358. DEPST(ig)= epstf(ig) - epst0(ig)
  1359. ENDDO
  1360. C
  1361. nucar = xcarb(/1)
  1362. IF((mfr.EQ.7.OR.mfr.EQ.13.OR.mfr.EQ.15.OR.mfr.EQ.17)
  1363. & .AND. CMATE.NE.'SECTION ') THEN
  1364. *
  1365. IF (mfr.EQ.15) THEN
  1366. NUCAR=NUCAR/2
  1367. IE=1
  1368. pilnec = liluc(14,2)
  1369. c segact pilnec*nomod
  1370. mobl = pilobl(/1)
  1371. mfac = pilfac(/1)
  1372. DO 1007 IC=1,3,2
  1373. DO 1107 ICOMP=1,min(NUCAR,mobl)
  1374. deche = pilobl(icomp,2)
  1375. if (deche.gt.0) then
  1376. c segact deche
  1377. melval = ABS(ieldec)
  1378. c segact melval
  1379. IAUX=MELVAL
  1380. IF (IAUX.NE.0) THEN
  1381. IGMN=MIN(IC,VELCHE(/1))
  1382. IBMN=MIN(IB,VELCHE(/2))
  1383. VALCAR(IE)=VELCHE(IGMN,IBMN)
  1384. ELSE
  1385. VALCAR(IE)=0.D0
  1386. ENDIF
  1387. else
  1388. VALCAR(IE)=0.D0
  1389. endif
  1390. IE=IE+1
  1391. 1107 CONTINUE
  1392. 1007 CONTINUE
  1393. DO 1009 IC=1,3,2
  1394. DO 1109 ICOMP=1,mfac
  1395. deche = pilfac(icomp,2)
  1396. if (deche.gt.0) then
  1397. c segact deche
  1398. melval = ABS(ieldec)
  1399. c segact melval
  1400. IAUX=MELVAL
  1401. IF (IAUX.NE.0) THEN
  1402. IGMN=MIN(IC,VELCHE(/1))
  1403. IBMN=MIN(IB,VELCHE(/2))
  1404. VALCAR(IE)=VELCHE(IGMN,IBMN)
  1405. ELSE
  1406. VALCAR(IE)=0.D0
  1407. ENDIF
  1408. else
  1409. VALCAR(IE)=0.D0
  1410. endif
  1411. IE=IE+1
  1412. 1109 CONTINUE
  1413. 1009 CONTINUE
  1414. *
  1415. ELSE if (inplas.ne.73) then
  1416. * pour la loi de cisaillement 73, valcar ne sert a rien
  1417. pilnec = liluc(14,2)
  1418. c segact pilnec*nomod
  1419. mobl = pilobl(/1)
  1420. mfac = pilfac(/1)
  1421. DO 1010 ICOMP=1,pilobl(/1)
  1422. VALCAR(ICOMP)=0.D0
  1423. deche = pilobl(icomp,2)
  1424. if (deche.gt.0) then
  1425. c segact deche
  1426. melval = ABS(ieldec)
  1427. c segact melval
  1428. IAUX=MELVAL
  1429. DO 1008 IAUX1=1,NBPTEL
  1430. IF (IAUX.NE.0) THEN
  1431. IBMN=MIN(IB ,VELCHE(/2))
  1432. IGMN=MIN(IAUX1,VELCHE(/1))
  1433. VALCAR(ICOMP)=VALCAR(ICOMP)+VELCHE(IGMN,IBMN)
  1434. ENDIF
  1435. IF(IAUX1.EQ.NBPTEL) VALCAR(ICOMP)=VALCAR(ICOMP)/NBPTEL
  1436. 1008 CONTINUE
  1437. endif
  1438. 1010 CONTINUE
  1439. DO 1012 ICOMP=1,pilfac(/1)
  1440. VALCAR(mobl+ICOMP)=0.D0
  1441. deche = pilfac(icomp,2)
  1442. if (deche.gt.0) then
  1443. c segact deche
  1444. melval = ABS(ieldec)
  1445. c segact melval
  1446. IAUX=MELVAL
  1447. DO 1011 IAUX1=1,NBPTEL
  1448. IF (IAUX.NE.0) THEN
  1449. IF (ielche(/2).ne.0) THEN
  1450. IBMN=MIN(IB ,IELCHE(/2))
  1451. IGMN=MIN(IAUX1,IELCHE(/1))
  1452. VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+IELCHE(IGMN,IBMN)
  1453. ELSE
  1454. IBMN=MIN(IB ,VELCHE(/2))
  1455. IGMN=MIN(IAUX1,VELCHE(/1))
  1456. VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+VELCHE(IGMN,IBMN)
  1457. ENDIF
  1458. ENDIF
  1459. IF(IAUX1.EQ.NBPTEL) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)/NBPTEL
  1460. 1011 CONTINUE
  1461. endif
  1462. 1012 CONTINUE
  1463. ENDIF
  1464.  
  1465. else
  1466. if (nucar.gt.0) then
  1467. do ip = 1,nucar
  1468. valcar(ip) = xcarb(ip)
  1469. enddo
  1470. endif
  1471. ENDIF
  1472. *
  1473. * prise en compte de l'epaisseur et de l'excentrement
  1474. * dans le cas des coques minces avec ou sans cisaillement
  1475. * transverse
  1476. *
  1477. IF (mfr.EQ.3.OR.mfr.EQ.9) THEN
  1478. IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR.
  1479. 1 CMATE.EQ.'UNIDIREC') THEN
  1480. pilnec = liluc(14,2)
  1481. * segact pilnec
  1482. deche = pilobl(1,2)
  1483. c segact deche
  1484. if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2)
  1485. melval = ABS(ieldec)
  1486. c segact melval
  1487. IAUX=MELVAL
  1488. IF (IAUX.NE.0) THEN
  1489. IBMN=MIN(IB ,VELCHE(/2))
  1490. IGMN=MIN(IGAU,VELCHE(/1))
  1491. EPAIST=VELCHE(IGMN,IBMN)
  1492. ELSE
  1493. EPAIST=0.D0
  1494. ENDIF
  1495. ENDIF
  1496. ENDIF
  1497. **
  1498. * on traite le materiau dependant de la temperature pour lemaitre endommageable
  1499. if (inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) then
  1500. do ic = 1,tyval(/2)
  1501. if (tyval(ic)(9:16).EQ.'EVOLUTIO') then
  1502. MEVOLL=nint(valmat(ic))
  1503. IF(MEVOLL.EQ.0) THEN
  1504. KERRE=37
  1505. RETURN
  1506. ENDIF
  1507. C SEGACT MEVOLL
  1508. KEVOLL=IEVOLL(1)
  1509. C SEGACT KEVOLL
  1510. if (nomevx(1:4).eq.'T ') ITHHER = 2
  1511. * on ne desactive pas les segments pour reduire la contention sur esope en //
  1512. *** segdes kevoll,mevoll
  1513. if (ithher.eq.2) goto 4010
  1514. endif
  1515. if (tyval(ic)(9:16).EQ.'NUAGE ') then
  1516. MNUAGE=nint(valmat(ic))
  1517. C SEGACT MNUAGE
  1518. IF(MNUAGE.EQ.0) THEN
  1519. MOTERR(1:8)='NUAGE '
  1520. CALL ERREUR(37)
  1521. KERRE=37
  1522. RETURN
  1523. ENDIF
  1524. NVAR=NUANOM(/2)
  1525. IF(NVAR.LE.1) THEN
  1526. * on ne desactive pas les segments pour reduire la contention sur esope en //
  1527. *** SEGDES MNUAGE
  1528. INTERR(1)=MNUAGE
  1529. INTERR(2)=2
  1530. INTERR(3)=2
  1531. CALL ERREUR(628)
  1532. KERRE=628
  1533. RETURN
  1534. ENDIF
  1535. if (nuanom(1).eq.'T ') ITHHER = 2
  1536. * on ne desactive pas les segments pour reduire la contention sur esope en //
  1537. *** segdes mnuage
  1538. if (ithher.eq.2) goto 4010
  1539. endif
  1540. enddo
  1541. 4010 continue
  1542. endif
  1543. C
  1544. RETURN
  1545. END
  1546.  
  1547.  

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