Télécharger comval.eso

Retour à la liste

Numérotation des lignes :

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

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