Télécharger comval.eso

Retour à la liste

Numérotation des lignes :

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

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