Télécharger comval.eso

Retour à la liste

Numérotation des lignes :

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

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