Télécharger comval.eso

Retour à la liste

Numérotation des lignes :

  1. C COMVAL SOURCE CB215821 19/08/20 21:16:16 10287
  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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=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. 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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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=ABS(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 = ABS(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) = ABS(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) then
  740. call erreur(1073)
  741. return
  742. endif
  743. tyval (ic)= typdec
  744. xmatf(ic) = passe1
  745. mkkatf(ic)=deche
  746. else if (ir.eq.mran ) then
  747. xmatf(ic) = passe1
  748. mkkatf(ic)=deche
  749. endif
  750. if (igau.eq.1.and.ib.eq.1) then
  751. IF (CMATE.EQ.'SECTION ') THEN
  752. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  753. N2EL =MAX(N2EL ,IELCHE(/2))
  754. ELSE
  755. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  756. N2EL =MAX(N2EL ,VELCHE(/2))
  757. ENDIF
  758. endif
  759. GOTO 120
  760.  
  761. * caracteristiques geometriques
  762. 14 if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  763. comcar(ic) = lesobl(ic)
  764. tycar(ic) = 'REAL*8 '
  765. endif
  766. mblcar=mobl
  767. if (ipilo1.le.0.and.mfrbi.ne.9.and.mfrbi.ne.3) goto 100
  768. if (ir.eq.1) then
  769. xcar0(ic) = passe1
  770. mkkar0(ic)=deche
  771. elseif (ir.gt.1.and.ir.le.(mran-1)) then
  772. if (deche.eq.0) then
  773. call erreur(1073)
  774. return
  775. endif
  776. tycar(ic) = typdec
  777. XCARB(ic) = passe1
  778. mkkarb(ic)=deche
  779. xcarbf(ic) = passe1
  780. mkkrbf(ic)=deche
  781. *
  782. * tuyaux
  783. *
  784. IF (mfrbi.eq.13) THEN
  785. C
  786. C Poutre 3D
  787. C
  788. ELSE IF(MFRbi.EQ.7.AND.IDIM.EQ.3)THEN
  789. C
  790. C Poutre 2D
  791. C
  792. ELSEIF(IDIM.EQ.2) THEN
  793. if (ipilo1.le.0.and.ic.eq.2) then
  794. IF(MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN
  795. XCARB(IC)=0.66666666666666D0
  796. ENDIF
  797. endif
  798. ELSE
  799. * cas des coques minces : défaut de alfah
  800. IF (ipilo1.le.0.and.IC.EQ.2.AND.
  801. & (MFRbi.EQ.3.OR.MFRbi.EQ.9)) THEN
  802. XCARB(IC)=0.666666666666666D0
  803. ENDIF
  804. C
  805. ENDIF
  806.  
  807. else if (ir.eq.mran) then
  808. xcarbf(ic) = passe1
  809. mkkrbf(ic)=deche
  810. endif
  811. if(deche.ne.0) mkkarz=1
  812. GOTO 120
  813. *
  814. 15 if (ipilo1.le.0) goto 100
  815. if (ir.eq.1) then
  816. ture0(ic) = passe1
  817. mkkre0(ic)=deche
  818. else if (ir.ge.(mran -1)) then
  819. turef(ic) = passe1
  820. mkkref(ic)=deche
  821. endif
  822. if(deche.ne.0) mkkrez=1
  823. GOTO 120
  824. *
  825. 16 if (ipilo1.le.0) goto 100
  826. if (ir.eq.1) then
  827. prin0(ic) = passe1
  828. mkkin0(ic)=deche
  829. else if (ir.ge.(mran -1)) then
  830. prinf(ic) = passe1
  831. mkkinf(ic)=deche
  832. endif
  833. if(deche.ne.0) mkkinz=1
  834. GOTO 120
  835. *
  836. 17 if (ipilo1.le.0) goto 100
  837. if (ir.eq.1) then
  838. maho0(ic) = passe1
  839. mkkho0(ic)=deche
  840. else if (ir.ge.(mran -1)) then
  841. mahof(ic) = passe1
  842. mkkhof(ic)=deche
  843. endif
  844. if(deche.ne.0) mkkhoz=1
  845. GOTO 120
  846. *
  847. 18 if (ipilo1.le.0) goto 100
  848. if (ir.eq.1) then
  849. hota0(ic) = passe1
  850. mkkta0(ic)=deche
  851. else if (ir.ge.(mran -1)) then
  852. hotaf(ic) = passe1
  853. mkktaf(ic)=deche
  854. endif
  855. if(deche.ne.0) mkktaz=1
  856. GOTO 120
  857. *
  858. 20 if (ipilo1.le.0) goto 100
  859. if (ir.eq.1) then
  860. VAR0(ic) = passe1
  861. * write(6,*) 'var0 ', passe1
  862. mkkvr0(ic)=deche
  863. else if (ir.ge.(mran -1)) then
  864. VARF(ic) = passe1
  865. mkkvrf(ic)=deche
  866. endif
  867. if(deche.ne.0) mkkvrz=1
  868. GOTO 120
  869. *
  870. 21 if (ipilo1.le.0) goto 100
  871. if (ir.eq.1) then
  872. graf0(ic) = passe1
  873. mkkaf0(ic)=deche
  874. else if (ir.ge.(mran -1)) then
  875. graff(ic) = passe1
  876. mkkaff(ic)=deche
  877. endif
  878. if(deche.ne.0) mkkafz=1
  879. GOTO 120
  880. *
  881. 23 if (ipilo1.le.0) goto 100
  882. if (ir.eq.1) then
  883. rhas0(ic) = passe1
  884. mkkas0(ic)=deche
  885. else if (ir.ge.(mran -1)) then
  886. rhasf(ic) = passe1
  887. mkkasf(ic)=deche
  888. endif
  889. if(deche.ne.0) mkkasz=1
  890. GOTO 120
  891. *
  892. 24 if (ipilo1.le.0) goto 100
  893. if (ir.eq.1) then
  894. EPIN0(ic) = passe1
  895. mkkpn0(ic)=deche
  896. else if (ir.ge.(mran -1)) then
  897. EPINF(ic) = passe1
  898. mkkpnf(ic)=deche
  899. endif
  900. if(deche.ne.0) mkkpnz=1
  901. GOTO 120
  902. *
  903. 25 if (ipilo1.le.0) goto 100
  904. if (ir.eq.1) then
  905. PAREX0(ic) = passe1
  906. mkkex0(ic)=deche
  907. else if (ir.ge.(mran -1)) then
  908. PAREXF(ic) = passe1
  909. mkkexf(ic)=deche
  910. endif
  911. if(deche.ne.0) mkkexz=1
  912. GOTO 120
  913. *
  914. 98 if (ipilo1.le.0) goto 100
  915. if (ir.eq.1) then
  916. exova0(ic) = passe1
  917. mkkvx0(ic)=deche
  918. else if (ir.ge.(mran -1)) then
  919. exova1(ic) = passe1
  920. mkkvx1(ic)=deche
  921. endif
  922. if (nomexo(ic).eq.'STEP ') istep = int(exova0(ic))
  923. if(deche.ne.0) mkkvxz=1
  924. GOTO 120
  925. *
  926. 120 CONTINUE
  927. *
  928. 100 continue
  929.  
  930. 101 continue
  931. *
  932. * if (mfac.le.0) goto 301
  933. do 200 ic = 1,mfac
  934. passe1= 0.d0
  935. ipilo2 = pilfac(ic,ir)
  936. if (pilfac(ic,ir).gt.0) then
  937. deche = pilfac(ic,ir)
  938. c segact deche
  939. * on evite les deche crees pour le modele
  940. * if (ib.eq.1.and.igau.eq.1)
  941. * & write(6,*) ino,ir,ic,deche,nomdec,typdec,condec
  942. if (ir.eq.indeso.and.condec(1:24).eq.conmod(1:24))goto 200
  943. melval = ABS(ieldec)
  944. c segact melval
  945. if (typree) then
  946. IBMN=MIN(IB,VELCHE(/2))
  947. IGMN=MIN(IGAU,VELCHE(/1))
  948. passe1=VELCHE(IGMN,IBMN)
  949. else
  950. IBMN=MIN(IB,IELCHE(/2))
  951. IGMN=MIN(IGAU,IELCHE(/1))
  952. passe1=DBLE(IELCHE(IGMN,IBMN))
  953. endif
  954. endif
  955. *
  956. * AIGUILLAGE SUIVANT MOT CLE
  957. *
  958. if (ino.gt.nmot) goto 298
  959. GOTO ( 201,202,299,299,299,206, 207,299,299,210,211,
  960. & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino
  961. *
  962. 299 CONTINUE
  963. c pas de composantes pour ce champ
  964. RETURN
  965. *
  966. 201 if (ipilo2.le.0) goto 200
  967. if (ir.eq.1) then
  968. scal0(mobl+ic) = passe1
  969. mkkal0(ic+mobl)=deche
  970. else if (ir.ge.(mran -1)) then
  971. scalf(mobl+ic) = passe1
  972. mkklaf(ic+mobl)=deche
  973. endif
  974. if(deche.ne.0) mkkalz=1
  975. GOTO 320
  976. *
  977. 202 if (ipilo2.le.0) goto 200
  978. * bizarre de passer la ...
  979. GOTO 320
  980. *
  981. 206 if (ipilo2.le.0) goto 200
  982. if (ir.eq.1) then
  983. depl0(mobl+ic) = passe1
  984. mkkpl0(ic+mobl)=deche
  985. else if (ir.ge.(mran -1)) then
  986. deplf(mobl+ic) = passe1
  987. mkkplf(ic+mobl)=deche
  988. endif
  989. if(deche.ne.0) mkkplz=1
  990. GOTO 320
  991. *
  992. 207 if (ipilo2.le.0) goto 200
  993. if (ir.eq.1) then
  994. forc0(mobl+ic) = passe1
  995. mkkrc0(ic+mobl)=deche
  996. else if (ir.ge.(mran -1)) then
  997. forcf(mobl+ic) = passe1
  998. mkkrcf(ic+mobl)=deche
  999. endif
  1000. if(deche.ne.0) mkkrcz=1
  1001. GOTO 320
  1002. *
  1003. 210 if (ipilo2.le.0) goto 200
  1004. if (ir.eq.1) then
  1005. grad0(mobl+ic) = passe1
  1006. mkkad0(ic+mobl)=deche
  1007. else if (ir.ge.(mran -1)) then
  1008. gradf(mobl+ic) = passe1
  1009. mkkadf(ic+mobl)=deche
  1010. endif
  1011. if(deche.ne.0) mkkadz=1
  1012. GOTO 320
  1013. *
  1014. 211 if (ipilo2.le.0) goto 200
  1015. if (ir.eq.1) then
  1016. SIG0(mobl+ic) = passe1
  1017. mkkig0(ic+mobl)=deche
  1018. else if (ir.ge.(mran -1)) then
  1019. SIGF(mobl+ic) = passe1
  1020. mkkigf(ic+mobl)=deche
  1021. endif
  1022. if(deche.ne.0) mkkigz=1
  1023. GOTO 320
  1024. *
  1025. 212 if (ipilo2.le.0) goto 200
  1026. if (ir.eq.1) then
  1027. epst0(mobl+ic) = passe1
  1028. mkkst0(ic+mobl) =deche
  1029. else if (ir.gt.1.and.ir.le.mran) then
  1030. epstf(mobl+ic) = passe1
  1031. mkkstf(ic+mobl) = deche
  1032. endif
  1033. if(deche.ne.0) mkkstz=1
  1034. GOTO 320
  1035. *
  1036. 213 continue
  1037. if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then
  1038. commat(mobl+ic) = lesfac(ic)
  1039. tyval(mobl+ic) = 'REAL*8 '
  1040. endif
  1041. if (ir.gt.1) then
  1042. ivalma(mobl+ic) = 0
  1043. if (ipilo2.gt.0) ivalma(mobl+ic) = ABS(ieldec)
  1044. endif
  1045. if (ipilo2.le.0) goto 200
  1046. if (ir.eq.1) then
  1047. valma0(mobl+ic) = passe1
  1048. mkkva0(ic+mobl)=deche
  1049. elseif (ir.gt.1.and.ir.le.(mran - 1)) then
  1050. VALMAT(mobl+ic) = passe1
  1051. mkkvat(ic+mobl)=deche
  1052. if (deche.eq.0) then
  1053. call erreur(1073)
  1054. return
  1055. endif
  1056. tyval(mobl+ic) = typdec
  1057. xmatf(mobl+ic) = passe1
  1058. mkkatf(ic+mobl)=deche
  1059. if ((inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142)
  1060. & .and.nomdec(1:4).eq.'ALPH') then
  1061. ** if (typdec(1:8).eq.'REAL*8 '.or.typdec(1:8).eq.'POINTEUR')
  1062. if (typree .or.typdec(1:8).eq.'POINTEUR')
  1063. & ITHHER=1
  1064. endif
  1065. else if (ir.eq.mran) then
  1066. xmatf(mobl+ic) = passe1
  1067. mkkatf(ic+mobl)=deche
  1068. endif
  1069. if (igau.eq.1.and.ib.eq.1) then
  1070. IF (CMATE.EQ.'SECTION ') THEN
  1071. N2PTEL=MAX(N2PTEL,IELCHE(/1))
  1072. N2EL =MAX(N2EL ,IELCHE(/2))
  1073. ELSE
  1074. N2PTEL=MAX(N2PTEL,VELCHE(/1))
  1075. N2EL =MAX(N2EL ,VELCHE(/2))
  1076. ENDIF
  1077. endif
  1078. GOTO 320
  1079. *
  1080. 214 if (ib.eq.1.and.igau.eq.1.and.ir.eq.1) then
  1081. comcar(mobl+ic)=lesfac(ic)
  1082. tycar(mobl+ic)='REAL*8 '
  1083. endif
  1084. if (ipilo2.le.0.and.mfrbi.ne.9.and.mfrbi.ne.3) goto 200
  1085. if (ir.eq.1) then
  1086. xcar0(mobl+ic) = passe1
  1087. mkkar0(ic+mobl)=deche
  1088. else if (ir.gt.1.and.ir.le.(mran -1)) then
  1089. XCARB(mobl+ic) = passe1
  1090. mkkarb(ic+mobl)=deche
  1091. xcarbf(mobl+ic) = passe1
  1092. if (deche.eq.0) then
  1093. call erreur(1073)
  1094. return
  1095. endif
  1096. tycar(mobl+ic) = typdec
  1097. *
  1098. * tuyaux
  1099. *
  1100. IF (mfrbi.eq.13) THEN
  1101. * composante VECT
  1102. if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT ') then
  1103. ip = int(passe1)
  1104. mkkarb(ic+mobl)=deche
  1105. IREF=(IP-1)*(IDIM+1)
  1106. * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR
  1107. DO 3208 IC2=1,IDIM
  1108. XCARB(ncarr+IC2)=XCOOR(IREF+IC2)
  1109. 3208 continue
  1110. else
  1111. DO 3209 IC2=1,IDIM
  1112. XCARB(ncarr+IC2)=0.d0
  1113. 3209 continue
  1114. endif
  1115. C
  1116. C Poutre 3D
  1117. C
  1118. ELSE IF(MFRbi.EQ.7.AND.IDIM.EQ.3)THEN
  1119. * composante VECT
  1120. if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT ') then
  1121. IP=int(passe1)
  1122. mkkarb(ic+mobl)=deche
  1123. IREF=(IP-1)*(IDIM+1)
  1124. * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR
  1125. DO 4208 IC2=1,IDIM
  1126. XCARB(ncarr+IC2)=XCOOR(IREF+IC2)
  1127. 4208 continue
  1128. else
  1129. DO 4209 IC2=1,IDIM
  1130. XCARB(ncarr+IC2)=0.D0
  1131. 4209 continue
  1132. endif
  1133. C
  1134. C Poutre 2D
  1135. C
  1136. ELSEIF(IDIM.EQ.2) THEN
  1137. if (ipilo2.le.0.and.mobl+ic.eq.2) then
  1138. IF(MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN
  1139. XCARB(mobl+IC)=0.66666666666666D0
  1140. ENDIF
  1141. endif
  1142. ELSE
  1143. * cas des coques minces : défaut de alfah
  1144. IF (ipilo2.le.0.and.mobl+IC.EQ.2.AND.
  1145. & (MFRbi.EQ.3.OR.MFRbi.EQ.9)) THEN
  1146. XCARB(mobl+IC)=0.666666666666666D0
  1147. ENDIF
  1148. C
  1149. C
  1150. ENDIF
  1151. else if (ir.ge.mran) then
  1152. xcarbf(mobl+ic) = passe1
  1153. mkkrbf(ic+mobl)=deche
  1154. endif
  1155. if(deche.ne.0) mkkarz=1
  1156. GOTO 320
  1157. *
  1158. 215 if (ipilo2.le.0) goto 200
  1159. if (ir.eq.1) then
  1160. ture0(mobl+ic) = passe1
  1161. mkkre0(ic+mobl)=deche
  1162. else if (ir.ge.(mran -1)) then
  1163. turef(mobl+ic) = passe1
  1164. mkkref(ic+mobl)=deche
  1165. endif
  1166. if(deche.ne.0) mkkrez=1
  1167. GOTO 320
  1168. *
  1169. 216 if (ipilo2.le.0) goto 200
  1170. if (ir.eq.1) then
  1171. prin0(mobl+ic) = passe1
  1172. mkkin0(ic+mobl)=deche
  1173. else if (ir.ge.(mran -1)) then
  1174. prinf(mobl+ic) = passe1
  1175. mkkinf(ic+mobl)=deche
  1176. endif
  1177. if(deche.ne.0) mkkinz=1
  1178. GOTO 320
  1179. *
  1180. 217 if (ipilo2.le.0) goto 200
  1181. if (ir.eq.1) then
  1182. maho0(mobl+ic) = passe1
  1183. mkkho0(ic+mobl)=deche
  1184. else if (ir.ge.(mran -1)) then
  1185. mahof(mobl+ic) = passe1
  1186. mkkhof(ic+mobl)=deche
  1187. endif
  1188. if(deche.ne.0) mkkhoz=1
  1189. GOTO 320
  1190. *
  1191. 218 if (ipilo2.le.0) goto 200
  1192. if (ir.eq.1) then
  1193. hota0(mobl+ic) = passe1
  1194. mkkta0(ic+mobl)=deche
  1195. else if (ir.ge.(mran -1)) then
  1196. hotaf(mobl+ic) = passe1
  1197. mkktaf(ic+mobl)=deche
  1198. endif
  1199. if(deche.ne.0) mkktaz=1
  1200. GOTO 320
  1201. *
  1202. 220 if (ipilo2.le.0) goto 200
  1203. if (ir.eq.1) then
  1204. VAR0(mobl+ic) = passe1
  1205. mkkvr0(ic+mobl)=deche
  1206. else if (ir.ge.(mran -1)) then
  1207. VARF(mobl+ic) = passe1
  1208. mkkvrf(ic+mobl)=deche
  1209. endif
  1210. if(deche.ne.0) mkkvrz=1
  1211. GOTO 320
  1212. *
  1213. 221 if (ipilo2.le.0) goto 200
  1214. if (ir.eq.1) then
  1215. graf0(mobl+ic) = passe1
  1216. mkkaf0(ic+mobl)=deche
  1217. else if (ir.ge.(mran -1)) then
  1218. graff(mobl+ic) = passe1
  1219. mkkaff(ic+mobl)=deche
  1220. endif
  1221. if(deche.ne.0) mkkafz=1
  1222. GOTO 320
  1223. *
  1224. 223 if (ipilo2.le.0) goto 200
  1225. if (ir.eq.1) then
  1226. rhas0(mobl+ic) = passe1
  1227. mkkas0(ic+mobl)=deche
  1228. else if (ir.ge.(mran -1)) then
  1229. rhasf(mobl+ic) = passe1
  1230. mkkasf(ic+mobl)=deche
  1231. endif
  1232. if(deche.ne.0) mkkasz=1
  1233. GOTO 320
  1234. *
  1235. 224 if (ipilo2.le.0) goto 200
  1236. if (ir.eq.1) then
  1237. EPIN0(mobl+ic) = passe1
  1238. mkkpn0(ic+mobl)=deche
  1239. else if (ir.ge.(mran -1)) then
  1240. EPINF(mobl+ic) = passe1
  1241. mkkpnf(ic+mobl)=deche
  1242. endif
  1243. if(deche.ne.0) mkkpnz=1
  1244. GOTO 320
  1245. *
  1246. 298 if (ipilo2.le.0) goto 200
  1247. exova0(mobl + ic) = passe1
  1248. mkkvx0(ic+mobl)=deche
  1249. if(deche.ne.0) mkkvxz=1
  1250. GOTO 320
  1251. *
  1252. 320 CONTINUE
  1253.  
  1254. 200 continue
  1255.  
  1256. 301 continue
  1257.  
  1258. 3000 continue
  1259. *
  1260. 1000 continue
  1261. 1001 continue
  1262. *
  1263. dt = tempf - temp0
  1264. *
  1265. if (igau.eq.1.and.ib.eq.1) then
  1266. IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN
  1267. N2PTEL=1
  1268. ELSE
  1269. N2PTEL=NBG
  1270. ENDIF
  1271. endif
  1272. *
  1273. do ig = 1, depst(/1)
  1274. DEPST(ig)= epstf(ig) - epst0(ig)
  1275. enddo
  1276. *
  1277. nucar = xcarb(/1)
  1278. IF((MFRbi.EQ.7.OR.MFRbi.EQ.13.OR.MFRbi.EQ.15.OR.MFRbi.EQ.17)
  1279. 1 .AND. CMATE.NE.'SECTION ') THEN
  1280. *
  1281. IF (MFRbi.EQ.15) THEN
  1282. NUCAR=NUCAR/2
  1283. IE=1
  1284. pilnec = liluc(14,2)
  1285. c segact pilnec*nomod
  1286. mobl = pilobl(/1)
  1287. mfac = pilfac(/1)
  1288. DO 1007 IC=1,3,2
  1289. DO 1107 ICOMP=1,min(NUCAR,mobl)
  1290. deche = pilobl(icomp,2)
  1291. if (deche.gt.0) then
  1292. c segact deche
  1293. melval = ABS(ieldec)
  1294. c segact melval
  1295. IAUX=MELVAL
  1296. IF (IAUX.NE.0) THEN
  1297. IGMN=MIN(IC,VELCHE(/1))
  1298. IBMN=MIN(IB,VELCHE(/2))
  1299. VALCAR(IE)=VELCHE(IGMN,IBMN)
  1300. ELSE
  1301. VALCAR(IE)=0.D0
  1302. ENDIF
  1303. else
  1304. VALCAR(IE)=0.D0
  1305. endif
  1306. IE=IE+1
  1307. 1107 CONTINUE
  1308. 1007 CONTINUE
  1309. DO 1009 IC=1,3,2
  1310. DO 1109 ICOMP=1,mfac
  1311. deche = pilfac(icomp,2)
  1312. if (deche.gt.0) then
  1313. c segact deche
  1314. melval = ABS(ieldec)
  1315. c segact melval
  1316. IAUX=MELVAL
  1317. IF (IAUX.NE.0) THEN
  1318. IGMN=MIN(IC,VELCHE(/1))
  1319. IBMN=MIN(IB,VELCHE(/2))
  1320. VALCAR(IE)=VELCHE(IGMN,IBMN)
  1321. ELSE
  1322. VALCAR(IE)=0.D0
  1323. ENDIF
  1324. else
  1325. VALCAR(IE)=0.D0
  1326. endif
  1327. IE=IE+1
  1328. 1109 CONTINUE
  1329. 1009 CONTINUE
  1330. *
  1331. ELSE if (inplas.ne.73) then
  1332. * pour la loi de cisaillement 73, valcar ne sert a rien
  1333. pilnec = liluc(14,2)
  1334. c segact pilnec*nomod
  1335. mobl = pilobl(/1)
  1336. mfac = pilfac(/1)
  1337. DO 1010 ICOMP=1,pilobl(/1)
  1338. VALCAR(ICOMP)=0.D0
  1339. deche = pilobl(icomp,2)
  1340. if (deche.gt.0) then
  1341. c segact deche
  1342. melval = ABS(ieldec)
  1343. c segact melval
  1344. IAUX=MELVAL
  1345. DO 1008 IAUX1=1,NBPTEL
  1346. IF (IAUX.NE.0) THEN
  1347. IBMN=MIN(IB ,VELCHE(/2))
  1348. IGMN=MIN(IAUX1,VELCHE(/1))
  1349. VALCAR(ICOMP)=VALCAR(ICOMP)+VELCHE(IGMN,IBMN)
  1350. ENDIF
  1351. IF(IAUX1.EQ.NBPTEL) VALCAR(ICOMP)=VALCAR(ICOMP)/NBPTEL
  1352. 1008 CONTINUE
  1353. endif
  1354. 1010 CONTINUE
  1355. DO 1012 ICOMP=1,pilfac(/1)
  1356. VALCAR(mobl+ICOMP)=0.D0
  1357. deche = pilfac(icomp,2)
  1358. if (deche.gt.0) then
  1359. c segact deche
  1360. melval = ABS(ieldec)
  1361. c segact melval
  1362. IAUX=MELVAL
  1363. DO 1011 IAUX1=1,NBPTEL
  1364. IF (IAUX.NE.0) THEN
  1365. IF (ielche(/2).ne.0) THEN
  1366. IBMN=MIN(IB ,IELCHE(/2))
  1367. IGMN=MIN(IAUX1,IELCHE(/1))
  1368. VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+IELCHE(IGMN,IBMN)
  1369. ELSE
  1370. IBMN=MIN(IB ,VELCHE(/2))
  1371. IGMN=MIN(IAUX1,VELCHE(/1))
  1372. VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+VELCHE(IGMN,IBMN)
  1373. ENDIF
  1374. ENDIF
  1375. IF(IAUX1.EQ.NBPTEL) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)/NBPTEL
  1376. 1011 CONTINUE
  1377. endif
  1378. 1012 CONTINUE
  1379. ENDIF
  1380.  
  1381. else
  1382. if (nucar.gt.0) then
  1383. do ip = 1,nucar
  1384. valcar(ip) = xcarb(ip)
  1385. enddo
  1386. endif
  1387. ENDIF
  1388. *
  1389. IF(.false.) THEN
  1390. * kich la section est surchargee dans comara
  1391. * IF(MFRbi.EQ.27.OR.MFRbi.EQ.49) THEN
  1392. *
  1393. * on cherche la section de l'element ib
  1394. *
  1395. pilnec = liluc(14,2)
  1396. * segact pilnec
  1397. if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2)
  1398. IF( deche.eq.0) then
  1399. sect=0.d0
  1400. ELSE
  1401. c segact deche
  1402. melval = ABS(ieldec)
  1403. c segact melval
  1404. IAUX=MELVAL
  1405. IF (IAUX.NE.0) THEN
  1406. IBMN=MIN(IB ,VELCHE(/2))
  1407. IGMN=MIN(IGAU,VELCHE(/1))
  1408. SECT=VELCHE(IGMN,IBMN)
  1409. ELSE
  1410. SECT=0.D0
  1411. ENDIF
  1412. ENDIF
  1413. ENDIF
  1414. *
  1415. * prise en compte de l'epaisseur et de l'excentrement
  1416. * dans le cas des coques minces avec ou sans cisaillement
  1417. * transverse
  1418. *
  1419. IF (MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN
  1420. IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR.
  1421. 1 CMATE.EQ.'UNIDIREC') THEN
  1422. pilnec = liluc(14,2)
  1423. * segact pilnec
  1424. deche = pilobl(1,2)
  1425. c segact deche
  1426. if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2)
  1427. melval = ABS(ieldec)
  1428. c segact melval
  1429. IAUX=MELVAL
  1430. IF (IAUX.NE.0) THEN
  1431. IBMN=MIN(IB ,VELCHE(/2))
  1432. IGMN=MIN(IGAU,VELCHE(/1))
  1433. EPAIST=VELCHE(IGMN,IBMN)
  1434. ELSE
  1435. EPAIST=0.D0
  1436. ENDIF
  1437. ENDIF
  1438. ENDIF
  1439. **
  1440. c on veut travailler sur tous les pgauss sans economie
  1441. NBGMAT = NBPTEL
  1442. NELMAT = NEL
  1443.  
  1444. * on traite le materiau dependant de la temperature pour lemaitre endommageable
  1445. if (inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) then
  1446. do ic = 1,tyval(/2)
  1447. if (tyval(ic)(9:16).EQ.'EVOLUTIO') then
  1448. MEVOLL=nint(valmat(ic))
  1449. IF(MEVOLL.EQ.0) THEN
  1450. KERRE=37
  1451. RETURN
  1452. ENDIF
  1453. C SEGACT MEVOLL
  1454. KEVOLL=IEVOLL(1)
  1455. C SEGACT KEVOLL
  1456. if (nomevx(1:4).eq.'T ') ITHHER = 2
  1457. * on ne desactive pas les segments pour reduire la contention sur esope en //
  1458. *** segdes kevoll,mevoll
  1459. if (ithher.eq.2) goto 4010
  1460. endif
  1461. if (tyval(ic)(9:16).EQ.'NUAGE ') then
  1462. MNUAGE=nint(valmat(ic))
  1463. C SEGACT MNUAGE
  1464. IF(MNUAGE.EQ.0) THEN
  1465. MOTERR(1:8)='NUAGE '
  1466. CALL ERREUR(37)
  1467. KERRE=37
  1468. RETURN
  1469. ENDIF
  1470. NVAR=NUANOM(/2)
  1471. IF(NVAR.LE.1) THEN
  1472. * on ne desactive pas les segments pour reduire la contention sur esope en //
  1473. *** SEGDES MNUAGE
  1474. INTERR(1)=MNUAGE
  1475. INTERR(2)=2
  1476. INTERR(3)=2
  1477. CALL ERREUR(628)
  1478. KERRE=628
  1479. RETURN
  1480. ENDIF
  1481. if (nuanom(1).eq.'T ') ITHHER = 2
  1482. * on ne desactive pas les segments pour reduire la contention sur esope en //
  1483. *** segdes mnuage
  1484. if (ithher.eq.2) goto 4010
  1485. endif
  1486. enddo
  1487. 4010 continue
  1488. * ---> PLastique endommageable de Lemaitre
  1489. IF ( INPLAS .EQ. 26 ) THEN
  1490. C* Test refait juste apres
  1491. C* IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  1492. C* TREFA = 20.
  1493. C* ENDIF
  1494. PRECIS = 1.d-8
  1495. ENDIF
  1496. endif
  1497. **
  1498. IF (INPLAS.NE.43) THEN
  1499. IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN
  1500. TREFA= 20.D0
  1501. ENDIF
  1502. ENDIF
  1503.  
  1504. **
  1505. RETURN
  1506. END
  1507.  
  1508.  
  1509.  
  1510.  
  1511.  
  1512.  
  1513.  
  1514.  
  1515.  
  1516.  
  1517.  
  1518.  
  1519.  
  1520.  
  1521.  
  1522.  
  1523.  
  1524.  
  1525.  
  1526.  
  1527.  
  1528.  
  1529.  

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