Télécharger nor2d3.eso

Retour à la liste

Numérotation des lignes :

  1. C NOR2D3 SOURCE CB215821 19/03/20 21:15:11 10165
  2. SUBROUTINE NOR2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR,
  3. & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL,
  4. & MLENNE,MLENMI,MPOVCL,
  5. & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,
  6. & SCMB,INDLI,
  7. & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT,
  8. & NSOMM,NBMAX)
  9.  
  10.  
  11.  
  12. C
  13. C************************************************************************
  14. C
  15. C PROJET : CASTEM 2000
  16. C
  17. C NOM : NORV2
  18. C
  19. C DESCRIPTION : Appelle par NORV1
  20. C
  21. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  22. C
  23. C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS
  24. C
  25. C************************************************************************
  26. C
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (a-h,o-z)
  29. -INC SMLENTI
  30. -INC SMELEME
  31. -INC SMCHPOI
  32. -INC CCOPTIO
  33. -INC SMCOORD
  34. -INC SMLREEL
  35. POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME,
  36. & MELTFA.MELEME, MELEP2.MELEME
  37. POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL,
  38. & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL,
  39. & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL
  40. POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI,
  41. & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,MLEFA2.MLENTI
  42. -INC SMCHAML
  43. INTEGER NBNN,NBREF
  44.  
  45.  
  46.  
  47. C
  48. C**** Variables de COOPTIO
  49. C
  50. C
  51. C**** Variables de COOPTIO
  52. C
  53. c INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  54. c & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  55. c & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  56. c & ,IECHO, IIMPI, IOSPI
  57. c & ,IDIM
  58. C & ,MCOORD
  59. c & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  60. c & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  61. c & ,NORINC,NORVAL,NORIND,NORVAD
  62. c & ,NUCROU, IPSAUV
  63.  
  64. C**** Variable de SMLENTI, SMCHPOI
  65. C
  66. INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM
  67. C
  68. C**** Les includes
  69. C
  70. INTEGER I1,ICOMP,ICOMGR,IGEOM
  71. & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM
  72. & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF
  73. & ,NTOT,NSOMM,NCOMP,NFAC,NCEN
  74. & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2
  75. & ,NLS1,NLS2,NLFCL
  76. & ,ISOUS,IELEM,INOEUD,ICELL
  77. INTEGER ICEN2
  78. REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,VALZ,XG,XD,XF,XS1,XS2
  79. & ,YG,YD,YF,YS1,YS2,ZG,ZD,ZF,ZS1,ZS2,
  80. & PSCA,XNORM,VECX,VECY,VECZ,PSCAGX,PSCAGY,PSCAGZ,
  81. & PSCADX,PSCADY,PSCADZ,K11G,K22G,K21G,K31G,K32G,K33G,
  82. & K11D,K22D,K21D,K31D,K32D,K33D,VXG1,VXG2,
  83. & VXAU,VYAU,VZAU,VXD1,VXD2,VYG1,VYG2,VYD1,VYD2,VZG1,
  84. & VZG2,VZD1,VZD2,TRG1,TRG2,
  85. & TRD1,TRD2,TRG,TRD
  86. REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2,
  87. & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,VZ,
  88. & COEF1X,COEF2X,COEF1Y,COEF2Y,COEF1Z,COEF2Z,
  89. & CX,CY,CZ,ANCX,ANCY,ANCZ,DIFFX,DIFFY,DIFFZ,XLONGG,XLONGD,
  90. & VALD,VALG,COEF,GX,GY,GZ,XMINK11,XMAXK11,XMINK22,XMAXK22,
  91. & QIMPX,QIMPY,QIMPZ,QIMPS,XLAMBDA1,XLAMBDA2
  92.  
  93. c REAL*8 VECXG1(3),VECYG1(3)
  94. c REAL*8 VECXG2(3),VECYG2(3)
  95. c REAL*8 VECXD1(3),VECYD1(3)
  96. c REAL*8 VECXD2(3),VECYD2(3)
  97.  
  98. REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4)
  99. REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4)
  100. REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4)
  101. REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4)
  102. INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4)
  103. INTEGER NLOCFG(4,4),NLOCFD(4,4)
  104. REAL*8 EPS
  105. INTEGER ICRIT
  106. CHARACTER*8 TYPE
  107. C CHARACTER*(4) NOMCOM(18)
  108. C DATA NOMCOM /'P1DX','P1DY',
  109. C & 'P2DX','P2DY',
  110. C & 'P3DX','P3DY',
  111. C & 'P4DX','P4DY',
  112. C & 'P5DX','P5DY',
  113. C & 'P6DX','P6DY',
  114. C & 'P7DX','P7DY',
  115. C & 'P8DX','P8DY',
  116. C & 'P9DX','P9DY'/
  117.  
  118. INTEGER NDIM
  119. SEGMENT MMAT1
  120. REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM)
  121. INTEGER IC(NDIM)
  122. ENDSEGMENT
  123.  
  124. INTEGER K1,K2
  125. SEGMENT INDICE
  126. INTEGER NUME(K1,K2)
  127. ENDSEGMENT
  128. POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE
  129.  
  130. SEGMENT MATRICE
  131. REAL*8 MAT(K1,K2)
  132. ENDSEGMENT
  133. POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE
  134.  
  135. INTEGER K3
  136. SEGMENT POINT2
  137. INTEGER POINT(K3)
  138. ENDSEGMENT
  139. POINTEUR IPO2.POINT2
  140.  
  141. SEGMENT MATRICE2
  142. REAL*8 MAT2(K1,K2)
  143. ENDSEGMENT
  144. POINTEUR MATR1.MATRICE2,MATR2.MATRICE2
  145.  
  146.  
  147. SEGMENT REP
  148. INTEGER ID(K3)
  149. ENDSEGMENT
  150. POINTEUR TAB.REP,INDLI.REP
  151.  
  152. INTEGER K5
  153. SEGMENT NBFAC
  154. INTEGER NBFACEL(K5)
  155. INTEGER IMELEM(K5)
  156. ENDSEGMENT
  157.  
  158. INTEGER K6
  159. SEGMENT NBCOT
  160. INTEGER NBCOTE(K6)
  161. INTEGER IMECOTE(K6)
  162. ENDSEGMENT
  163.  
  164.  
  165.  
  166. c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS
  167. c SOUS DOMAINE
  168.  
  169. MAUX = MELTFA
  170. MAUX2 = MELEFP
  171. NMAI1 = 0
  172. NMAI2 = 0
  173. NMAI3 = 0
  174. C NMAI4 = 0
  175.  
  176. C Initialisation sinon NAN...
  177. DO II=1,4
  178. SURFAGX(II)=0.D0
  179. SURFAGY(II)=0.D0
  180. SURFAGZ(II)=0.D0
  181. SURFADX(II)=0.D0
  182. SURFADY(II)=0.D0
  183. SURFADZ(II)=0.D0
  184. ENDDO
  185.  
  186. NBSO = MAX(1,MELTFA.LISOUS(/1))
  187. c WRITE(6,*) 'NBSO MAILLE= ',NBSO
  188. c WRITE(6,*) 'MELTFA= ',MELTFA
  189. IF (NBSO.EQ.1) THEN
  190. K5 = MELTFA.NUM(/2)
  191. ELSEIF (NBSO.EQ.2) THEN
  192. IPT1 = MELTFA.LISOUS(1)
  193. SEGACT IPT1
  194. N1 = IPT1.NUM(/2)
  195. NMAI1 = N1
  196. SEGDES IPT1
  197. IPT2 = MELTFA.LISOUS(2)
  198. SEGACT IPT2
  199. N2 = IPT2.NUM(/2)
  200. NMAI2 = N2
  201. SEGDES IPT2
  202. K5 = N1 + N2
  203. ELSEIF (NBSO.EQ.3) THEN
  204. IPT1 = MELTFA.LISOUS(1)
  205. SEGACT IPT1
  206. N1 = IPT1.NUM(/2)
  207. NMAI1 = N1
  208. SEGDES IPT1
  209. IPT2 = MELTFA.LISOUS(2)
  210. SEGACT IPT2
  211. N2 = IPT2.NUM(/2)
  212. NMAI2 = N2
  213. SEGDES IPT2
  214. IPT3 = MELTFA.LISOUS(3)
  215. SEGACT IPT3
  216. N3 = IPT3.NUM(/2)
  217. NMAI3 = N3
  218. SEGDES IPT3
  219. K5 = N1 + N2 + N3
  220. ELSEIF (NBSO.EQ.4) THEN
  221. IPT1 = MELTFA.LISOUS(1)
  222. SEGACT IPT1
  223. N1 = IPT1.NUM(/2)
  224. NMAI1 = N1
  225. SEGDES IPT1
  226. IPT2 = MELTFA.LISOUS(2)
  227. SEGACT IPT2
  228. N2 = IPT2.NUM(/2)
  229. NMAI2 = N2
  230. SEGDES IPT2
  231. IPT3 = MELTFA.LISOUS(3)
  232. SEGACT IPT3
  233. N3 = IPT3.NUM(/2)
  234. NMAI3 = N3
  235. SEGDES IPT3
  236. IPT4 = MELTFA.LISOUS(4)
  237. SEGACT IPT4
  238. N4 = IPT4.NUM(/2)
  239. C NMAI4 = N4
  240. SEGDES IPT4
  241. K5 = N1 + N2 + N3 + N4
  242. ENDIF
  243. c WRITE(6,*) 'K5= ',K5
  244.  
  245.  
  246.  
  247. IF (NBSO.EQ.1) THEN
  248. DO I = 1,K5
  249. NTYPE = MELTFA.ITYPEL
  250. c WRITE(6,*) 'NTYPE= ',NTYPE
  251. IF (NTYPE .EQ. 16) THEN
  252. NBFACEL(I) = 6
  253. IMELEM(I) = MELTFA
  254. ELSEIF (NTYPE .EQ. 25) THEN
  255. NBFACEL(I) = 5
  256. IMELEM(I) = MELTFA
  257. ELSEIF (NTYPE .EQ. 23) THEN
  258. NBFACEL(I) = 4
  259. IMELEM(I) = MELTFA
  260. ELSEIF (NTYPE .EQ. 9) THEN
  261. NBFACEL(I) = 5
  262. IMELEM(I) = MELTFA
  263. ENDIF
  264. c SEGDES MELTFA
  265. ENDDO
  266. ELSEIF (NBSO.EQ.2) THEN
  267. IPT1 = MELTFA.LISOUS(1)
  268. SEGACT IPT1
  269. IPT2 = MELTFA.LISOUS(2)
  270. SEGACT IPT2
  271. DO I = 1,K5
  272. N1 = IPT1.NUM(/2)
  273. IF (I.LE.N1) THEN
  274. NTYPE = IPT1.ITYPEL
  275. IF (NTYPE .EQ. 16) THEN
  276. NBFACEL(I) = 6
  277. IMELEM(I) = IPT1
  278. ELSEIF (NTYPE .EQ. 25) THEN
  279. NBFACEL(I) = 5
  280. IMELEM(I) = IPT1
  281. ELSEIF (NTYPE .EQ. 23) THEN
  282. NBFACEL(I) = 4
  283. IMELEM(I) = IPT1
  284. ELSEIF (NTYPE .EQ. 9) THEN
  285. NBFACEL(I) = 5
  286. IMELEM(I) = IPT1
  287. ENDIF
  288. ELSE
  289. NTYPE = IPT2.ITYPEL
  290. IF (NTYPE .EQ. 16) THEN
  291. NBFACEL(I) = 6
  292. IMELEM(I) = IPT2
  293. ELSEIF (NTYPE .EQ. 25) THEN
  294. NBFACEL(I) = 5
  295. IMELEM(I) = IPT2
  296. ELSEIF (NTYPE .EQ. 23) THEN
  297. NBFACEL(I) = 4
  298. IMELEM(I) = IPT2
  299. ELSEIF (NTYPE .EQ. 9) THEN
  300. NBFACEL(I) = 5
  301. IMELEM(I) = IPT2
  302. ENDIF
  303. ENDIF
  304. ENDDO
  305. ELSEIF (NBSO.EQ.3) THEN
  306. IPT1 = MELTFA.LISOUS(1)
  307. SEGACT IPT1
  308. NTYPE = IPT1.ITYPEL
  309. c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  310. IPT2 = MELTFA.LISOUS(2)
  311. SEGACT IPT2
  312. NTYPE = IPT2.ITYPEL
  313. c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  314. IPT3 = MELTFA.LISOUS(3)
  315. SEGACT IPT3
  316. NTYPE = IPT3.ITYPEL
  317. c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  318. N1 = IPT1.NUM(/2)
  319. N2 = IPT2.NUM(/2)
  320. N3 = IPT3.NUM(/2)
  321. DO I = 1,K5
  322. IF (I.LE.N1) THEN
  323. NTYPE = IPT1.ITYPEL
  324. IF (NTYPE .EQ. 16) THEN
  325. NBFACEL(I) = 6
  326. IMELEM(I) = IPT1
  327. ELSEIF (NTYPE .EQ. 25) THEN
  328. NBFACEL(I) = 5
  329. IMELEM(I) = IPT1
  330. ELSEIF (NTYPE .EQ. 23) THEN
  331. NBFACEL(I) = 4
  332. IMELEM(I) = IPT1
  333. ELSEIF (NTYPE .EQ. 9) THEN
  334. NBFACEL(I) = 5
  335. IMELEM(I) = IPT1
  336. ENDIF
  337. ELSEIF (I.LE.(N1+N2)) THEN
  338. NTYPE = IPT2.ITYPEL
  339. IF (NTYPE .EQ. 16) THEN
  340. NBFACEL(I) = 6
  341. IMELEM(I) = IPT2
  342. ELSEIF (NTYPE .EQ. 25) THEN
  343. NBFACEL(I) = 5
  344. IMELEM(I) = IPT2
  345. ELSEIF (NTYPE .EQ. 23) THEN
  346. NBFACEL(I) = 4
  347. IMELEM(I) = IPT2
  348. ELSEIF (NTYPE .EQ. 9) THEN
  349. NBFACEL(I) = 5
  350. IMELEM(I) = IPT2
  351. ENDIF
  352. ELSE
  353. NTYPE = IPT3.ITYPEL
  354. IF (NTYPE .EQ. 16) THEN
  355. NBFACEL(I) = 6
  356. IMELEM(I) = IPT3
  357. ELSEIF (NTYPE .EQ. 25) THEN
  358. NBFACEL(I) = 5
  359. IMELEM(I) = IPT3
  360. ELSEIF (NTYPE .EQ. 23) THEN
  361. NBFACEL(I) = 4
  362. IMELEM(I) = IPT3
  363. ELSEIF (NTYPE .EQ. 9) THEN
  364. NBFACEL(I) = 5
  365. IMELEM(I) = IPT3
  366. ENDIF
  367. ENDIF
  368. ENDDO
  369. ELSEIF (NBSO.EQ.4) THEN
  370. IPT1 = MELTFA.LISOUS(1)
  371. SEGACT IPT1
  372. NTYPE = IPT1.ITYPEL
  373. c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL
  374. IPT2 = MELTFA.LISOUS(2)
  375. SEGACT IPT2
  376. NTYPE = IPT2.ITYPEL
  377. c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL
  378. IPT3 = MELTFA.LISOUS(3)
  379. SEGACT IPT3
  380. NTYPE = IPT3.ITYPEL
  381. c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL
  382. IPT4 = MELTFA.LISOUS(4)
  383. SEGACT IPT4
  384. NTYPE = IPT4.ITYPEL
  385. c WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL
  386. N1 = IPT1.NUM(/2)
  387. N2 = IPT2.NUM(/2)
  388. N3 = IPT3.NUM(/2)
  389. N4 = IPT4.NUM(/2)
  390. DO I = 1,K5
  391. IF (I.LE.N1) THEN
  392. NTYPE = IPT1.ITYPEL
  393. IF (NTYPE .EQ. 16) THEN
  394. NBFACEL(I) = 6
  395. IMELEM(I) = IPT1
  396. ELSEIF (NTYPE .EQ. 25) THEN
  397. NBFACEL(I) = 5
  398. IMELEM(I) = IPT1
  399. ELSEIF (NTYPE .EQ. 23) THEN
  400. NBFACEL(I) = 4
  401. IMELEM(I) = IPT1
  402. ELSEIF (NTYPE .EQ. 9) THEN
  403. NBFACEL(I) = 5
  404. IMELEM(I) = IPT1
  405. ENDIF
  406. ELSEIF (I.LE.(N1+N2)) THEN
  407. NTYPE = IPT2.ITYPEL
  408. IF (NTYPE .EQ. 16) THEN
  409. NBFACEL(I) = 6
  410. IMELEM(I) = IPT2
  411. ELSEIF (NTYPE .EQ. 25) THEN
  412. NBFACEL(I) = 5
  413. IMELEM(I) = IPT2
  414. ELSEIF (NTYPE .EQ. 23) THEN
  415. NBFACEL(I) = 4
  416. IMELEM(I) = IPT2
  417. ELSEIF (NTYPE .EQ. 9) THEN
  418. NBFACEL(I) = 5
  419. IMELEM(I) = IPT2
  420. ENDIF
  421. ELSEIF (I.LE.(N1+N2+N3)) THEN
  422. NTYPE = IPT3.ITYPEL
  423. IF (NTYPE .EQ. 16) THEN
  424. NBFACEL(I) = 6
  425. IMELEM(I) = IPT3
  426. ELSEIF (NTYPE .EQ. 25) THEN
  427. NBFACEL(I) = 5
  428. IMELEM(I) = IPT3
  429. ELSEIF (NTYPE .EQ. 23) THEN
  430. NBFACEL(I) = 4
  431. IMELEM(I) = IPT3
  432. ELSEIF (NTYPE .EQ. 9) THEN
  433. NBFACEL(I) = 5
  434. IMELEM(I) = IPT3
  435. ENDIF
  436. ELSE
  437. NTYPE = IPT4.ITYPEL
  438. IF (NTYPE .EQ. 16) THEN
  439. NBFACEL(I) = 6
  440. IMELEM(I) = IPT4
  441. ELSEIF (NTYPE .EQ. 25) THEN
  442. NBFACEL(I) = 5
  443. IMELEM(I) = IPT4
  444. ELSEIF (NTYPE .EQ. 23) THEN
  445. NBFACEL(I) = 4
  446. IMELEM(I) = IPT4
  447. ELSEIF (NTYPE .EQ. 9) THEN
  448. NBFACEL(I) = 5
  449. IMELEM(I) = IPT4
  450. ENDIF
  451. ENDIF
  452. ENDDO
  453. ENDIF
  454.  
  455. C ON EST ICI CORRIGER K5
  456.  
  457. MLEFA2 = MLEFA
  458. CALL KRIPAD(MELEFA,MLEFA2)
  459. c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES
  460. NFAI1 = 0
  461. NBSOF = MAX(1,MELEFP.LISOUS(/1))
  462. c WRITE(6,*) 'NBSO FACE= ',NBSOF
  463. IF (NBSOF.EQ.1) THEN
  464. K6 = MELEFP.NUM(/2)
  465. ELSEIF (NBSOF.EQ.2) THEN
  466. IPT5 = MELEFP.LISOUS(1)
  467. SEGACT IPT5
  468. N1 = IPT5.NUM(/2)
  469. NFAI1 = N1
  470. SEGDES IPT5
  471. IPT6 = MELEFP.LISOUS(2)
  472. SEGACT IPT6
  473. N2 = IPT6.NUM(/2)
  474. C NFAI2 = N2
  475. SEGDES IPT6
  476. K6 = N1 + N2
  477. ENDIF
  478. c WRITE(6,*) 'K6= ',K6
  479.  
  480. SEGINI NBCOT
  481. c WRITE(6,*) 'POINT1'
  482. C ON EST ICI
  483. IF (NBSOF.EQ.1) THEN
  484. DO I = 1,K6
  485. NTYPE = MELEFP.ITYPEL
  486. c WRITE(6,*) 'NTYPE= ',NTYPE
  487. IF (NTYPE .EQ. 5) THEN
  488. NBCOTE(I) = 3
  489. IMECOTE(I) = MELEFP
  490. ELSE
  491. NBCOTE(I) = 4
  492. IMECOTE(I) = MELEFP
  493. ENDIF
  494. c SEGDES MELTFA
  495. ENDDO
  496. ELSEIF (NBSOF.EQ.2) THEN
  497. c WRITE(6,*) 'POINT2'
  498. IPT5 = MELEFP.LISOUS(1)
  499. SEGACT IPT5
  500. IPT6 = MELEFP.LISOUS(2)
  501. SEGACT IPT6
  502. c WRITE(6,*) 'IPT5= ',IPT5.ITYPEL
  503. c WRITE(6,*) 'IPT6= ',IPT6.ITYPEL
  504. DO I = 1,K6
  505. N1 = IPT5.NUM(/2)
  506. C MISE A JOUR DE MLEFA.LECT
  507. IF (I.LE.N1) THEN
  508. N0 = IPT5.NUM(/1)
  509. NGFAUX = IPT5.NUM(N0,I)
  510. MLEFA2.LECT(NGFAUX) = I
  511. c WRITE(6,*) 'NGFAUX = ',NGFAUX,
  512. c & 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  513. IF (IPT5.ITYPEL .EQ. 5) THEN
  514. NBCOTE(I) = 3
  515. IMECOTE(I) = IPT5
  516. ELSE
  517. NBCOTE(I) = 4
  518. IMECOTE(I) = IPT5
  519. ENDIF
  520. c SEGDES IPT5
  521. ELSE
  522. N0 = IPT6.NUM(/1)
  523. NGFAUX = IPT6.NUM(N0,I-NFAI1)
  524. MLEFA2.LECT(NGFAUX) = I
  525. c WRITE(6,*) 'NGFAUX = ',NGFAUX,
  526. c & 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  527. IF (IPT6.ITYPEL .EQ. 5) THEN
  528. NBCOTE(I) = 3
  529. IMECOTE(I) = IPT6
  530. ELSE
  531. NBCOTE(I) = 4
  532. IMECOTE(I) = IPT6
  533. ENDIF
  534. c SEGDES IPT6
  535. ENDIF
  536. c WRITE(6,*) 'I= ',I
  537. c WRITE(6,*) 'NBCOTE= ',NBCOTE(I)
  538. c WRITE(6,*) 'IMECOTE= ',IMECOTE(I)
  539.  
  540. ENDDO
  541. ENDIF
  542. C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT
  543. C EXEMPLE LES PRISMES
  544.  
  545. C SEGMENT SERVANT A UN PRECALCUL DE NBMAX
  546. c WRITE(6,*) 'NSOMM= ',NSOMM
  547. K3 = NSOMM
  548. SEGINI INDLI
  549. SEGINI TAB
  550. DO I = 1,K3
  551. INDLI.ID(I) = 0
  552. TAB.ID(I) = 0
  553. ENDDO
  554.  
  555. NFAC=MELEFL.NUM(/2)
  556. NBMAX = 0
  557.  
  558. C PRECALCUL DE NBMAX
  559. DO NLCF= 1, NFAC, 1
  560. c WRITE(6,*) 'NLCF= ',NLCF
  561. NGCF=MELEFL.NUM(2,NLCF)
  562. NGCG=MELEFL.NUM(1,NLCF)
  563. NGCD=MELEFL.NUM(3,NLCF)
  564. NLCG=MLECEN.LECT(NGCG)
  565. NLCD=MLECEN.LECT(NGCD)
  566. c NFAUX = MELEFA.NUM(NLCF,1)
  567. c WRITE(6,*) 'NFAUX= ',NFAUX
  568. c
  569. c NGFAUX = MELEFA.NUM(NLCF,1)
  570. c WRITE(6,*) 'NGFAUX = ',NGFAUX,
  571. c & 'MLEFA2=',MLEFA2.LECT(NGFAUX)
  572. c NBNO = MELEFP.NUM(/1) - 1
  573. NBNO = NBCOTE(NLCF)
  574. c WRITE(6,*) 'NLCF= ',NLCF
  575. c WRITE(6,*) 'NBNO= ',NBNO
  576. MELEFP = IMECOTE(NLCF)
  577. IF (NLCF.GT.NFAI1) THEN
  578. NLCFAUX = NLCF - NFAI1
  579. ELSE
  580. NLCFAUX = NLCF
  581. ENDIF
  582. DO IA = 1,NBNO
  583. NGS1=MELEFP.NUM(IA,NLCFAUX)
  584. NLS1=MLESOM.LECT(NGS1)
  585. NLS1=MLESOM.LECT(NGS1)
  586. INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1
  587. NBMAX = MAX(NBMAX,INDLI.ID(NLS1))
  588. ENDDO
  589.  
  590.  
  591. ENDDO
  592.  
  593.  
  594.  
  595. SEGSUP INDLI
  596. SEGSUP TAB
  597.  
  598. c NBMAX = 6
  599. NBMAX = NBMAX +1
  600. c WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX
  601. c WRITE(6,*) 'NBSOM= ',NSOMM
  602.  
  603.  
  604.  
  605.  
  606. C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL
  607. c INITIALISATION DES MATRICES
  608. c NBMAX = 10
  609. K3 = NSOMM
  610. SEGINI INDLI
  611. SEGINI TAB
  612. DO I = 1,K3
  613. INDLI.ID(I) = 0
  614. TAB.ID(I) = 0
  615. ENDDO
  616.  
  617. K1 = NBMAX
  618. K2 = NSOMM
  619. SEGINI IND2
  620. SEGINI IND
  621. SEGINI IND22
  622. SEGINI VAL1
  623. SEGINI VAL2
  624. SEGINI SCMB
  625.  
  626. * K1 = NBMAX
  627. * K2 = (NBMAX+1)
  628.  
  629. C INITIALISATION DU POINTEUR MATRICE2
  630. K3 = NSOMM
  631. SEGINI IPO2
  632. DO I = 1,K3
  633. K1 = NBMAX
  634. K2 = NBMAX + 1
  635. SEGINI MATR1
  636. IPO2.POINT(I) = MATR1
  637. SEGDES MATR1
  638. ENDDO
  639.  
  640.  
  641.  
  642.  
  643. c DO I = 1,K3
  644. c MATR1 = IPO2.POINT(I)
  645. c SEGACT MATR1 *MOD
  646. c MATR1.MAT2(1,1) = 4.D0
  647. c MATR1.MAT2(2,2) = 3.D0
  648. c WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1)
  649. c WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2)
  650. c SEGDES MATR1
  651. c ENDDO
  652.  
  653.  
  654.  
  655.  
  656. NFAC=MELEFL.NUM(/2)
  657.  
  658. c WRITE(6,*) 'NFAC= ',NFAC
  659. NAUX1 = 0
  660. DO NLCF= 1, NFAC, 1
  661. C INDICE = 0
  662.  
  663. c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION
  664. NGCF=MELEFL.NUM(2,NLCF)
  665.  
  666. NGCG=MELEFL.NUM(1,NLCF)
  667. NGCD=MELEFL.NUM(3,NLCF)
  668. NLCG=MLECEN.LECT(NGCG)
  669. NLCD=MLECEN.LECT(NGCD)
  670.  
  671.  
  672.  
  673.  
  674. SCNX=MPONOR.VPOCHA(NLCF,1)
  675. SCNY=MPONOR.VPOCHA(NLCF,2)
  676. SCNZ=MPONOR.VPOCHA(NLCF,3)
  677. SCN1X = SCNX
  678. SCN1Y = SCNY
  679. SCN1Z = SCNZ
  680.  
  681.  
  682. C 4=IDIM+1
  683. ICELL=(4*(NGCG -1))+1
  684. XG=MCOORD.XCOOR(ICELL)
  685. YG=MCOORD.XCOOR(ICELL+1)
  686. ZG=MCOORD.XCOOR(ICELL+2)
  687. ICELL=(4*(NGCD -1))+1
  688. XD=MCOORD.XCOOR(ICELL)
  689. YD=MCOORD.XCOOR(ICELL+1)
  690. ZD=MCOORD.XCOOR(ICELL+2)
  691. ICELL=(4*(NGCF -1))+1
  692. XF=MCOORD.XCOOR(ICELL)
  693. YF=MCOORD.XCOOR(ICELL+1)
  694. ZF=MCOORD.XCOOR(ICELL+2)
  695.  
  696. C MISE A ZERO DE NLOC
  697. DO JA=1,4
  698. DO IA=1,3
  699. NLOCFG(IA,JA) = 0
  700. NLOCFD(IA,JA) = 0
  701. ENDDO
  702. ENDDO
  703.  
  704. MELTFA = IMELEM(NLCG)
  705. NBF = NBFACEL(NLCG)
  706. IF (NLCG.LE.NMAI1) THEN
  707. NGAUX = NLCG
  708. ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN
  709. NGAUX = NLCG - NMAI1
  710. ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND.
  711. & (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN
  712. NGAUX = NLCG - (NMAI1+NMAI2)
  713. ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN
  714. NGAUX = NLCG - (NMAI1+NMAI2+NMAI3)
  715. ENDIF
  716. c WRITE(6,*) 'NLCG= ',NLCG
  717. c WRITE(6,*) 'NBF= ',NBF
  718. c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  719. c WRITE(6,*) 'MELTFA= ',MELTFA
  720. c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1)
  721. c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2)
  722. c WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2)
  723.  
  724. c SEGACT MELTFA
  725.  
  726. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  727. NLCF1 = MLEFA2.LECT(NGCF)
  728. NBNO = NBCOTE(NLCF1)
  729. MELEFP = IMECOTE(NLCF1)
  730. IF (NLCF1.GT.NFAI1) THEN
  731. NLCF1AUX = NLCF1 - NFAI1
  732. ELSE
  733. NLCF1AUX = NLCF1
  734. ENDIF
  735.  
  736. DO JA = 1,NBNO
  737. NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  738. c IF (NLCF.EQ.14) then
  739. c WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA)
  740. c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  741. c ENDIF
  742.  
  743. ICOUR = 0
  744. DO J = 1,NBF
  745. N1 = MELTFA.NUM(J,NGAUX)
  746. NL1 = MLEFA2.LECT(N1)
  747. NBNO2 = NBCOTE(NL1)
  748. MELEP2 = IMECOTE(NL1)
  749. IF (NL1.GT.NFAI1) THEN
  750. NL1AUX = NL1 - NFAI1
  751. ELSE
  752. NL1AUX = NL1
  753. ENDIF
  754. c IF (NLCF.EQ.14) then
  755. c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX
  756. c ENDIF
  757.  
  758.  
  759. DO IA =1,NBNO2
  760. NSOM1 = MELEP2.NUM(IA,NL1AUX)
  761. c IF (NLCF.EQ.14) then
  762. c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  763. c ENDIF
  764. IF (NSOM1.EQ.NGS(JA)) THEN
  765.  
  766. ICELL=(4*(N1 -1))+1
  767. XF=MCOORD.XCOOR(ICELL)
  768. YF=MCOORD.XCOOR(ICELL+1)
  769. ZF=MCOORD.XCOOR(ICELL+2)
  770.  
  771. ICOUR = ICOUR + 1
  772. VECXG(ICOUR,JA) = (XF - XG)
  773. VECYG(ICOUR,JA) = (YF - YG)
  774. VECZG(ICOUR,JA) = (ZF - ZG)
  775. NLOCFG(ICOUR,JA) = N1
  776. C ON PERMUTE
  777. C ICI
  778.  
  779. IF (N1.EQ.NGCF) THEN
  780. NAUX = NLOCFG(1,JA)
  781. VXAU = VECXG(1,JA)
  782. VYAU = VECYG(1,JA)
  783. VZAU = VECZG(1,JA)
  784. VECXG(1,JA) = (XF - XG)
  785. VECYG(1,JA) = (YF - YG)
  786. VECZG(1,JA) = (ZF - ZG)
  787. NLOCFG(1,JA) = N1
  788. VECXG(ICOUR,JA) = VXAU
  789. VECYG(ICOUR,JA) = VYAU
  790. VECZG(ICOUR,JA) = VZAU
  791. NLOCFG(ICOUR,JA) = NAUX
  792. ENDIF
  793. ENDIF
  794. ENDDO
  795. ENDDO
  796. c IF (NLCF.EQ.14) THEN
  797. c WRITE(6,*) 'JA= ',JA
  798. c WRITE(6,*) 'ICOUR= ',ICOUR
  799. c ENDIF
  800. ENDDO
  801.  
  802.  
  803. MELTFA = IMELEM(NLCD)
  804. NBF = NBFACEL(NLCD)
  805. c WRITE(6,*) 'NLCD= ',NLCD
  806. c WRITE(6,*) 'NBF= ',NBF
  807. c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL
  808.  
  809. IF (NLCD.LE.NMAI1) THEN
  810. NDAUX = NLCD
  811. ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN
  812. NDAUX = NLCD - NMAI1
  813. ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND.
  814. & (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN
  815. NDAUX = NLCD - (NMAI1+NMAI2)
  816. ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN
  817. NDAUX = NLCD - (NMAI1+NMAI2+NMAI3)
  818. ENDIF
  819.  
  820. C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE
  821. DO JA = 1,NBNO
  822. NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  823. c WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA)
  824. c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF
  825. ICOUR = 0
  826. DO J = 1,NBF
  827. N1 = MELTFA.NUM(J,NDAUX)
  828. NL1 = MLEFA2.LECT(N1)
  829. c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1
  830.  
  831. NBNO2 = NBCOTE(NL1)
  832. MELEP2 = IMECOTE(NL1)
  833. IF (NL1.GT.NFAI1) THEN
  834. NL1AUX = NL1 - NFAI1
  835. ELSE
  836. NL1AUX = NL1
  837. ENDIF
  838.  
  839.  
  840. DO IA =1,NBNO2
  841. NSOM1 = MELEP2.NUM(IA,NL1AUX)
  842. c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1
  843. IF (NSOM1.EQ.NGS(JA)) THEN
  844.  
  845. ICELL=(4*(N1 -1))+1
  846. XF=MCOORD.XCOOR(ICELL)
  847. YF=MCOORD.XCOOR(ICELL+1)
  848. ZF=MCOORD.XCOOR(ICELL+2)
  849.  
  850. ICOUR = ICOUR + 1
  851. VECXD(ICOUR,JA) = (XF - XD)
  852. VECYD(ICOUR,JA) = (YF - YD)
  853. VECZD(ICOUR,JA) = (ZF - ZD)
  854. NLOCFD(ICOUR,JA) = N1
  855. C ON PERMUTE
  856. IF (N1.EQ.NGCF) THEN
  857. NAUX = NLOCFD(1,JA)
  858. VXAU = VECXD(1,JA)
  859. VYAU = VECYD(1,JA)
  860. VZAU = VECZD(1,JA)
  861. VECXD(1,JA) = (XF - XD)
  862. VECYD(1,JA) = (YF - YD)
  863. VECZD(1,JA) = (ZF - ZD)
  864. NLOCFD(1,JA) = N1
  865. VECXD(ICOUR,JA) = VXAU
  866. VECYD(ICOUR,JA) = VYAU
  867. VECZD(ICOUR,JA) = VZAU
  868. NLOCFD(ICOUR,JA) = NAUX
  869. ENDIF
  870. ENDIF
  871. ENDDO
  872. ENDDO
  873. c WRITE(6,*) 'JA= ',JA
  874. c WRITE(6,*) 'ICOUR= ',ICOUR
  875. ENDDO
  876.  
  877. CALCUL DES VOLUMES
  878. c DO JA = 1,NBNO
  879. c DO KA=1,ICOUR
  880. c WRITE(6,*)'JA= ',JA,'KA= ',KA
  881. c WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  882. c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  883. c ENDDO
  884. c ENDDO
  885.  
  886. DO JA = 1,NBNO
  887.  
  888. DO KA = 1,ICOUR
  889. C PRODUIT MIXTES
  890. C PRODUIT VECTORIEL
  891. IF (KA.EQ.1) THEN
  892. PSCAGX = (VECYG(2,JA)*VECZG(3,JA)) -
  893. & (VECZG(2,JA)*VECYG(3,JA))
  894. PSCAGY = (VECZG(2,JA)*VECXG(3,JA)) -
  895. & (VECXG(2,JA)*VECZG(3,JA))
  896. PSCAGZ = (VECXG(2,JA)*VECYG(3,JA)) -
  897. & (VECYG(2,JA)*VECXG(3,JA))
  898. VOLUG(JA) = (VECXG(1,JA)* PSCAGX) +
  899. & (VECYG(1,JA)* PSCAGY) +
  900. & (VECZG(1,JA)* PSCAGZ)
  901. SURFAGX(KA) = 0.5D0* PSCAGX
  902. SURFAGY(KA) = 0.5D0* PSCAGY
  903. SURFAGZ(KA) = 0.5D0* PSCAGZ
  904. IF ( VOLUG(JA).GT.0) THEN
  905. SURFAGX(KA) = - SURFAGX(KA)
  906. SURFAGY(KA) = - SURFAGY(KA)
  907. SURFAGZ(KA) = - SURFAGZ(KA)
  908. ENDIF
  909. VOLUG(JA) = 1.D0/6.D0*ABS(VOLUG(JA))
  910. ENDIF
  911.  
  912. IF (KA.EQ.2) THEN
  913. PSCAGX = (VECYG(3,JA)*VECZG(1,JA)) -
  914. & (VECZG(3,JA)*VECYG(1,JA))
  915. PSCAGY = (VECZG(3,JA)*VECXG(1,JA)) -
  916. & (VECXG(3,JA)*VECZG(1,JA))
  917. PSCAGZ = (VECXG(3,JA)*VECYG(1,JA)) -
  918. & (VECYG(3,JA)*VECXG(1,JA))
  919. SURFAGX(KA) = 0.5D0* PSCAGX
  920. SURFAGY(KA) = 0.5D0* PSCAGY
  921. SURFAGY(KA) = 0.5D0* PSCAGY
  922. SURFAGZ(KA) = 0.5D0* PSCAGZ
  923. PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) +
  924. & (VECZG(2,JA)* PSCAGZ)
  925. IF ( PSCA.GT.0) THEN
  926. SURFAGX(KA) = - SURFAGX(KA)
  927. SURFAGY(KA) = - SURFAGY(KA)
  928. SURFAGZ(KA) = - SURFAGZ(KA)
  929. ENDIF
  930. ENDIF
  931.  
  932.  
  933. IF (KA.EQ.3) THEN
  934. PSCAGX = (VECYG(1,JA)*VECZG(2,JA)) -
  935. & (VECZG(1,JA)*VECYG(2,JA))
  936. PSCAGY = (VECZG(1,JA)*VECXG(2,JA)) -
  937. & (VECXG(1,JA)*VECZG(2,JA))
  938. PSCAGZ = (VECXG(1,JA)*VECYG(2,JA)) -
  939. & (VECYG(1,JA)*VECXG(2,JA))
  940.  
  941. SURFAGX(KA) = 0.5D0* PSCAGX
  942. SURFAGY(KA) = 0.5D0* PSCAGY
  943. SURFAGZ(KA) = 0.5D0* PSCAGZ
  944. PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) +
  945. & (VECZG(3,JA)* PSCAGZ)
  946. IF ( PSCA.GT.0) THEN
  947. SURFAGX(KA) = - SURFAGX(KA)
  948. SURFAGY(KA) = - SURFAGY(KA)
  949. SURFAGZ(KA) = - SURFAGZ(KA)
  950. ENDIF
  951. ENDIF
  952.  
  953. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  954. IF (ICHTE.EQ.0) THEN
  955. COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) +
  956. & (SURFAGZ(KA)*SCN1Z))
  957. & / (3.D0*VOLUG(JA))
  958.  
  959. ELSE
  960. C TENSEUR
  961. IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  962. K11G = MPOTEN.VPOCHA(NLCG,1)
  963. K22G = MPOTEN.VPOCHA(NLCG,2)
  964. K33G = MPOTEN.VPOCHA(NLCG,3)
  965. K21G = MPOTEN.VPOCHA(NLCG,4)
  966. K31G = MPOTEN.VPOCHA(NLCG,5)
  967. K32G = MPOTEN.VPOCHA(NLCG,6)
  968. ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  969. K11G = MPOTEN.VPOCHA(NLCG,1)
  970. K22G = K11G
  971. K33G = K11G
  972. K21G = 0.0D0
  973. K31G = 0.0D0
  974. K32G = 0.0D0
  975. ELSE
  976. WRITE(6,*) 'TENSEUR NON PREVU'
  977. STOP
  978. ENDIF
  979.  
  980. PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) +
  981. & (K31G*SURFAGZ(KA))
  982. PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) +
  983. & (K32G*SURFAGZ(KA))
  984. PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) +
  985. & (K33G*SURFAGZ(KA))
  986. COEFG(KA,JA) = (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) +
  987. & (PSCAGZ*SCN1Z)
  988. COEFG(KA,JA) = COEFG(KA,JA) / (3.D0*VOLUG(JA))
  989. ENDIF
  990. c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA)
  991. c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  992. c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  993. c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  994. ENDDO
  995. c WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA)
  996. c WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  997. c WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  998. c WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  999. c WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1000. c & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1001. c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1002. c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1003. c WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1004. c WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1005.  
  1006. ENDDO
  1007. CALCUL DES VOLUMES
  1008.  
  1009. DO JA = 1,NBNO
  1010. NGS(JA) = MELEFP.NUM(JA,NLCF1AUX)
  1011. NLS(JA)=MLESOM.LECT(NGS(JA))
  1012.  
  1013. DO KA = 1,ICOUR
  1014. C PRODUIT MIXTES
  1015. C PRODUIT VECTORIEL
  1016. IF (KA.EQ.1) THEN
  1017. PSCADX = (VECYD(2,JA)*VECZD(3,JA)) -
  1018. & (VECZD(2,JA)*VECYD(3,JA))
  1019. PSCADY = (VECZD(2,JA)*VECXD(3,JA)) -
  1020. & (VECXD(2,JA)*VECZD(3,JA))
  1021. PSCADZ = (VECXD(2,JA)*VECYD(3,JA)) -
  1022. & (VECYD(2,JA)*VECXD(3,JA))
  1023. VOLUD(JA) = (VECXD(1,JA)* PSCADX) +
  1024. & (VECYD(1,JA)* PSCADY) +
  1025. & (VECZD(1,JA)* PSCADZ)
  1026. SURFADX(KA) = 0.5D0* PSCADX
  1027. SURFADY(KA) = 0.5D0* PSCADY
  1028. SURFADZ(KA) = 0.5D0* PSCADZ
  1029. IF ( VOLUD(JA).GT.0) THEN
  1030. SURFADX(KA) = - SURFADX(KA)
  1031. SURFADY(KA) = - SURFADY(KA)
  1032. SURFADZ(KA) = - SURFADZ(KA)
  1033. ENDIF
  1034. VOLUD(JA) = 1.D0/6.D0*ABS(VOLUD(JA))
  1035.  
  1036. ENDIF
  1037.  
  1038. IF (KA.EQ.2) THEN
  1039. PSCADX = (VECYD(3,JA)*VECZD(1,JA)) -
  1040. & (VECZD(3,JA)*VECYD(1,JA))
  1041. PSCADY = (VECZD(3,JA)*VECXD(1,JA)) -
  1042. & (VECXD(3,JA)*VECZD(1,JA))
  1043. PSCADZ = (VECXD(3,JA)*VECYD(1,JA)) -
  1044. & (VECYD(3,JA)*VECXD(1,JA))
  1045. SURFADX(KA) = 0.5D0* PSCADX
  1046. SURFADY(KA) = 0.5D0* PSCADY
  1047. SURFADY(KA) = 0.5D0* PSCADY
  1048. SURFADZ(KA) = 0.5D0* PSCADZ
  1049. PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) +
  1050. & (VECZD(2,JA)* PSCADZ)
  1051. IF ( PSCA.GT.0) THEN
  1052. SURFADX(KA) = - SURFADX(KA)
  1053. SURFADY(KA) = - SURFADY(KA)
  1054. SURFADZ(KA) = - SURFADZ(KA)
  1055. ENDIF
  1056. ENDIF
  1057.  
  1058.  
  1059. IF (KA.EQ.3) THEN
  1060. PSCADX = (VECYD(1,JA)*VECZD(2,JA)) -
  1061. & (VECZD(1,JA)*VECYD(2,JA))
  1062. PSCADY = (VECZD(1,JA)*VECXD(2,JA)) -
  1063. & (VECXD(1,JA)*VECZD(2,JA))
  1064. PSCADZ = (VECXD(1,JA)*VECYD(2,JA)) -
  1065. & (VECYD(1,JA)*VECXD(2,JA))
  1066.  
  1067. SURFADX(KA) = 0.5D0* PSCADX
  1068. SURFADY(KA) = 0.5D0* PSCADY
  1069. SURFADZ(KA) = 0.5D0* PSCADZ
  1070. PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) +
  1071. & (VECZD(3,JA)* PSCADZ)
  1072. IF ( PSCA.GT.0) THEN
  1073. SURFADX(KA) = - SURFADX(KA)
  1074. SURFADY(KA) = - SURFADY(KA)
  1075. SURFADZ(KA) = - SURFADZ(KA)
  1076. ENDIF
  1077. ENDIF
  1078.  
  1079. c WRITE(6,*) 'NLCF=',NLCF
  1080. c WRITE(6,*) 'NLCD=',NLCD
  1081. c WRITE(6,*) 'NLCG=',NLCG
  1082. c WRite(6,*) 'AG1=',AG1
  1083. c WRite(6,*) 'AG2=',AG2
  1084. c WRite(6,*) 'AD1=',AD1
  1085. c WRite(6,*) 'AD2=',AD2
  1086. c WRite(6,*) 'PSCAG1=',PSCAG1
  1087. c WRite(6,*) 'PSCAG2=',PSCAG2
  1088. c WRite(6,*) 'PSCAD1=',PSCAD1
  1089. c WRite(6,*) 'PSCAD2=',PSCAD2
  1090. c WRite(6,*) 'COEF1D=',COEF1D
  1091. c WRite(6,*) 'COEF2D=',COEF2D
  1092. c WRite(6,*) 'BETA1GD=',BETA1GD
  1093. c WRite(6,*) 'BETA2GD=',BETA2GD
  1094. c WRite(6,*) 'INDD2=',INDD2
  1095.  
  1096. c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1
  1097. IF (ICHTE.EQ.0) THEN
  1098. COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) +
  1099. & (SURFADZ(KA)*SCN1Z))
  1100. & / (3.D0*VOLUD(JA))
  1101.  
  1102. ELSE
  1103. C TENSEUR
  1104. IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN
  1105. K11D = MPOTEN.VPOCHA(NLCD,1)
  1106. K22D = MPOTEN.VPOCHA(NLCD,2)
  1107. K33D = MPOTEN.VPOCHA(NLCD,3)
  1108. K21D = MPOTEN.VPOCHA(NLCD,4)
  1109. K31D = MPOTEN.VPOCHA(NLCD,5)
  1110. K32D = MPOTEN.VPOCHA(NLCD,6)
  1111. ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN
  1112. K11D = MPOTEN.VPOCHA(NLCD,1)
  1113. K22D = K11D
  1114. K33D = K11D
  1115. K21D = 0.0D0
  1116. K31D = 0.0D0
  1117. K32D = 0.0D0
  1118. ELSE
  1119. WRITE(6,*) 'TENSEUR NON PREVU'
  1120. STOP
  1121. ENDIF
  1122.  
  1123. PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) +
  1124. & (K31D*SURFADZ(KA))
  1125. PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) +
  1126. & (K32D*SURFADZ(KA))
  1127. PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) +
  1128. & (K33D*SURFADZ(KA))
  1129. COEFD(KA,JA) = (PSCADX*SCN1X) + (PSCADY*SCN1Y)
  1130. & + (PSCADZ*SCN1Z)
  1131. COEFD(KA,JA) = COEFD(KA,JA) / (3.D0*VOLUD(JA))
  1132. ENDIF
  1133. c WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA) = ',VOLUD(JA)
  1134. c WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA)
  1135. c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA)
  1136. ENDDO
  1137.  
  1138. c WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA)
  1139. c WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1140. c WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1141. c WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1142. c WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1143. c & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1144. c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1145. c WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1146. c WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1147. c WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1148.  
  1149. ENDDO
  1150. CALCUL DES VOLUMES
  1151.  
  1152. c WRITE(6,*) 'NLCF= ',NLCF
  1153. c WRITE(6,*) 'NGCF= ',NGCF
  1154. c WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1155. c WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1156. DO JA = 1,NBNO
  1157.  
  1158. C XX1 = ABS(COEFG(1,JA))
  1159. C XX2 = ABS(COEFD(1,JA))
  1160. C IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN
  1161. C INDICE = 1
  1162. C ENDIF
  1163.  
  1164. MARQ = 0
  1165. DO I5 = 1,INDLI.ID(NLS(JA))
  1166. INDAUX = IND2.NUME(I5,NLS(JA))
  1167. IF (INDAUX.EQ.NGCF) THEN
  1168. MARQ = 1
  1169. IAFF = I5
  1170. GOTO 4
  1171. ENDIF
  1172. ENDDO
  1173. 4 CONTINUE
  1174.  
  1175.  
  1176. IF (MARQ.EQ.0) THEN
  1177. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1178. ICOU = INDLI.ID(NLS(JA))
  1179. IND2.NUME(ICOU,NLS(JA)) = NGCF
  1180. ELSE
  1181. ICOU = IAFF
  1182. ENDIF
  1183.  
  1184.  
  1185. COEF = COEFG(1,JA)-COEFD(1,JA)
  1186. MATR1 = IPO2.POINT(NLS(JA))
  1187. c SEGINI MATR1
  1188. SEGACT MATR1 *MOD
  1189. MATR1.MAT2(ICOU,ICOU) = COEF
  1190.  
  1191. MARQ = 0
  1192. DO I5 = 1,INDLI.ID(NLS(JA))
  1193. INDAUX = IND2.NUME(I5,NLS(JA))
  1194. IF (INDAUX.EQ.NLOCFG(2,JA)) THEN
  1195. MARQ = 1
  1196. IAFF = I5
  1197. GOTO 5
  1198. ENDIF
  1199. ENDDO
  1200. 5 CONTINUE
  1201.  
  1202.  
  1203. IF (MARQ.EQ.0) THEN
  1204. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1205. ICOUCO = INDLI.ID(NLS(JA))
  1206. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(2,JA)
  1207. ELSE
  1208. ICOUCO = IAFF
  1209. ENDIF
  1210. ICOUG2 = ICOUCO
  1211.  
  1212.  
  1213. MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA)
  1214.  
  1215. MARQ = 0
  1216. DO I5 = 1,INDLI.ID(NLS(JA))
  1217. INDAUX = IND2.NUME(I5,NLS(JA))
  1218. IF (INDAUX.EQ.NLOCFG(3,JA)) THEN
  1219. MARQ = 1
  1220. IAFF = I5
  1221. GOTO 6
  1222. ENDIF
  1223. ENDDO
  1224. 6 CONTINUE
  1225.  
  1226.  
  1227. IF (MARQ.EQ.0) THEN
  1228. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1229. ICOUCO = INDLI.ID(NLS(JA))
  1230. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA)
  1231. ELSE
  1232. ICOUCO = IAFF
  1233. ENDIF
  1234. ICOUG3 = ICOUCO
  1235. MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA)
  1236.  
  1237.  
  1238. MARQ = 0
  1239. DO I5 = 1,INDLI.ID(NLS(JA))
  1240. INDAUX = IND2.NUME(I5,NLS(JA))
  1241. IF (INDAUX.EQ.NLOCFD(2,JA)) THEN
  1242. MARQ = 1
  1243. IAFF = I5
  1244. GOTO 59
  1245. ENDIF
  1246. ENDDO
  1247. 59 CONTINUE
  1248.  
  1249.  
  1250. IF (MARQ.EQ.0) THEN
  1251. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1252. ICOUCO = INDLI.ID(NLS(JA))
  1253. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(2,JA)
  1254. ELSE
  1255. ICOUCO = IAFF
  1256. ENDIF
  1257. ICOUD2 = ICOUCO
  1258.  
  1259.  
  1260. MATR1.MAT2(ICOU,ICOUCO) = - COEFD(2,JA)
  1261.  
  1262. MARQ = 0
  1263. DO I5 = 1,INDLI.ID(NLS(JA))
  1264. INDAUX = IND2.NUME(I5,NLS(JA))
  1265. IF (INDAUX.EQ.NLOCFD(3,JA)) THEN
  1266. MARQ = 1
  1267. IAFF = I5
  1268. GOTO 69
  1269. ENDIF
  1270. ENDDO
  1271. 69 CONTINUE
  1272.  
  1273.  
  1274. IF (MARQ.EQ.0) THEN
  1275. INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1
  1276. ICOUCO = INDLI.ID(NLS(JA))
  1277. IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA)
  1278. ELSE
  1279. ICOUCO = IAFF
  1280. ENDIF
  1281. ICOUD3 = ICOUCO
  1282. MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA)
  1283.  
  1284. c ON EST ICI
  1285.  
  1286. SCMB.MAT(ICOU,NLS(JA)) =
  1287. & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))
  1288. & *MPOCHP.VPOCHA(NLCG,1)) -
  1289. & ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))*
  1290. & MPOCHP.VPOCHA(NLCD,1))
  1291. c SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA))
  1292.  
  1293.  
  1294. c NLS1 = NLS(JA)
  1295. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1296. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1297. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1298. c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1299. c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1300. c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1301. c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3)
  1302. * ON EST ICI
  1303. * IL FAUT VERIFIER CE QUI EST AVANT
  1304.  
  1305.  
  1306. * COEF POUR INVERSER LA MATRICE
  1307.  
  1308. * ON CORRIGE ICI
  1309. VAL1.MAT(ICOU,NLS(JA)) =
  1310. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1311. c VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA))
  1312. VAL2.MAT(ICOU,NLS(JA)) =
  1313. & - (COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA))
  1314. c VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA))
  1315. IND.NUME(ICOU,NLS(JA)) = NGCG
  1316. IND22.NUME(ICOU,NLS(JA)) = NGCD
  1317.  
  1318. * CONDITION AUX LIMITE DE DIRICICHLET
  1319. IF (NGCG.EQ.NGCD) THEN
  1320. NLFCL=MLENCL.LECT(NGCF)
  1321. IF (NLFCL.GT.0) THEN
  1322. c WRITE(6,*) 'NLCF= ',NLCF
  1323. c WRITE(6,*) 'NGCF= ',NGCF
  1324. c WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1)
  1325. COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA)))
  1326. COEF = MAX(COEF,ABS(COEFG(3,JA)))
  1327. MATR1.MAT2(ICOU,ICOU) = COEF
  1328. MATR1.MAT2(ICOU,ICOUG2) = 0.0D0
  1329. MATR1.MAT2(ICOU,ICOUG3) = 0.0D0
  1330. MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1331. MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1332. SCMB.MAT(ICOU,NLS(JA)) = (COEF*MPOVCL.VPOCHA(NLFCL,1))
  1333. VAL1.MAT(ICOU,NLS(JA)) = 0.D0
  1334. VAL2.MAT(ICOU,NLS(JA)) = COEF
  1335. c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN
  1336. IND.NUME(ICOU,NLS(JA)) = NGCG
  1337. IND22.NUME(ICOU,NLS(JA)) = NGCF
  1338. ELSE
  1339. NLFNE=MLENNE.LECT(NGCF)
  1340.  
  1341. c CONDITION DE FLUX
  1342. IF (NLFNE.GT.0) THEN
  1343. QIMPX = MPOVNE.VPOCHA(NLFNE,1)
  1344. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1345. QIMPS = (QIMPX)
  1346. c WRITE(6,*) 'NGCF= ',NGCF
  1347. c WRITE(6,*) 'QIMPS= ',QIMPS
  1348.  
  1349. COEF = COEFG(1,JA)
  1350. MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1351. MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1352. MATR1.MAT2(ICOU,ICOU) = COEF
  1353. MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA)
  1354. MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA)
  1355.  
  1356. SCMB.MAT(ICOU,NLS(JA)) =
  1357. & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1358. & + (QIMPS)
  1359. VAL1.MAT(ICOU,NLS(JA)) =
  1360. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1361. VAL2.MAT(ICOU,NLS(JA)) = 1.D0
  1362. IND.NUME(ICOU,NLS(JA)) = NGCG
  1363. IND22.NUME(ICOU,NLS(JA)) = NGCF
  1364. NLS1 = NLS(JA)
  1365. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1366. c & 'SCMB', SCMB.MAT(ICOU,NLS1)
  1367. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1368. c & 'IND= ',IND.NUME(ICOU,NLS1),
  1369. c & 'IND22= ',IND22.NUME(ICOU,NLS1),
  1370. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1371. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1372. c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1373. c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1374. c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1375. c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1376.  
  1377. ELSE
  1378. c CONDITION MIXTE
  1379. NLFMI=MLENMI.LECT(NGCF)
  1380. IF (NLFMI.GT.0) THEN
  1381. XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1)
  1382. XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2)
  1383. QIMPX = MPOVMI.VPOCHA(NLFMI,3)
  1384. C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE
  1385. QIMPS = (QIMPX)
  1386.  
  1387. c WRITE(6,*) 'NLCF= ',NLCF
  1388. c WRITE(6,*) 'NGCF= ',NGCF
  1389. c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2
  1390. COEF = COEFG(1,JA)
  1391. c WRITE(6,*) 'COEF= ',COEF
  1392. c WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS
  1393. MATR1.MAT2(ICOU,ICOUD2) = 0.0D0
  1394. MATR1.MAT2(ICOU,ICOUD3) = 0.0D0
  1395. MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) -
  1396. & (1.D0*XLAMBDA2)
  1397. MATR1.MAT2(ICOU,ICOUG2) = (XLAMBDA1*COEFG(2,JA))
  1398. MATR1.MAT2(ICOU,ICOUG3) = (XLAMBDA1*COEFG(3,JA))
  1399. c ON EST ICI
  1400. SCMB.MAT(ICOU,NLS(JA)) =
  1401. & (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*
  1402. & MPOCHP.VPOCHA(NLCG,1)))
  1403. & + (1.D0*QIMPS)
  1404. VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1*
  1405. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1406. VAL2.MAT(ICOU,NLS(JA)) = 1.D0
  1407. IND.NUME(ICOU,NLS(JA)) = NGCG
  1408. IND22.NUME(ICOU,NLS(JA)) = NGCF
  1409. NLS1 = NLS(JA)
  1410. c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1411. c & 'IND= ',IND.NUME(ICOU,NLS1),
  1412. c & 'IND22= ',IND22.NUME(ICOU,NLS1),
  1413. c & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1414. c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1),
  1415. c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1),
  1416. c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1),
  1417. c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1),
  1418. c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1)
  1419. ELSE
  1420. C PAR DEFAUT FLUX NUL
  1421. QIMPS = 0
  1422. COEF = COEFG(1,JA)
  1423. MATR1.MAT2(ICOU,ICOU) = COEF
  1424. MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA)
  1425. MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA)
  1426. SCMB.MAT(ICOU,NLS(JA)) =
  1427. & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1))
  1428. VAL1.MAT(ICOU,NLS(JA)) =
  1429. & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA))
  1430. VAL2.MAT(ICOU,NLS(JA)) = 0.D0
  1431. IND.NUME(ICOU,NLS(JA)) = NGCG
  1432. IND22.NUME(ICOU,NLS(JA)) = NGCD
  1433. ENDIF
  1434.  
  1435. ENDIF
  1436.  
  1437. ENDIF
  1438. ENDIF
  1439.  
  1440. c WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ',
  1441. c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1),
  1442. c & 'HD= ',MPOCHP.VPOCHA(NLCD,1)
  1443.  
  1444. NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA)))
  1445. c WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1
  1446. c WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA),
  1447. c & 'INDLI.ID',INDLI.ID(NLS(JA))
  1448. c WRITE(6,*) 'JA= ',JA
  1449. c WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA)
  1450. c WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA)
  1451. c DO I5 = 1,INDLI.ID(NLS(JA))
  1452. c INDAUX = IND2.NUME(I5,NLS(JA))
  1453. c WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA),
  1454. c & 'IND2= ',IND2.NUME(I5,NLS(JA))
  1455. c ENDDO
  1456.  
  1457. C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS)
  1458. c SEGDES MATRICE2
  1459. c SEGACT MATRICE2
  1460. NLS1 = NLS(JA)
  1461. IF (ABS(COEF).LT. (-1.D0)) THEN
  1462. NLFCL=MLENCL.LECT(NGCF)
  1463. WRITE(6,*) 'CLIMD = ',NLFCL
  1464. NLFNE=MLENNE.LECT(NGCF)
  1465. WRITE(6,*) 'CLIMN = ',NLFNE
  1466. WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU,
  1467. & 'SCMB', SCMB.MAT(ICOU,NLS1),
  1468. & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF,
  1469. & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2),
  1470. & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3),
  1471. & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2),
  1472. & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3),
  1473. & 'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA)
  1474.  
  1475. c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA)
  1476. c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA)
  1477. c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA)
  1478. WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1479. WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA)
  1480. WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA)
  1481. WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA)
  1482. WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA)
  1483. WRITE(6,*)'NLCF= ',NLCF,'COEFG = ',
  1484. & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA)
  1485. WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1486. WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1)
  1487. WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2)
  1488. WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3)
  1489.  
  1490. WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA)
  1491. WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA)
  1492. WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA)
  1493. WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA)
  1494. WRITE(6,*)'NLCF= ',NLCF,'COEFD = ',
  1495. & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA)
  1496. WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z
  1497. WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1)
  1498. WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2)
  1499. WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3)
  1500. WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G
  1501. WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D
  1502.  
  1503. ENDIF
  1504.  
  1505. SEGDES MATR1 * MOD
  1506.  
  1507. ENDDO
  1508.  
  1509.  
  1510.  
  1511. c IF (INDICE.EQ.1) THEN
  1512. c WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT'
  1513. c ENDIF
  1514. ENDDO
  1515.  
  1516.  
  1517. IF (NAUX1.GT.NBMAX) THEN
  1518. WRITE(6,*) 'ERREUR DANS LES PARAMETRES'
  1519. c STOP
  1520. ENDIF
  1521. c DO J= 1,INDLI.ID(NLS1)
  1522. c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF)
  1523. c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF)
  1524. c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF)
  1525. c ENDDO
  1526.  
  1527. MELTFA = MAUX
  1528. MELEFP = MAUX2
  1529. IF (NBSO.EQ.2) THEN
  1530. SEGDES IPT1
  1531. SEGDES IPT2
  1532. ELSEIF (NBSO.EQ.3) THEN
  1533. SEGDES IPT1
  1534. SEGDES IPT2
  1535. SEGDES IPT3
  1536. ELSEIF (NBSO.EQ.4) THEN
  1537. SEGDES IPT1
  1538. SEGDES IPT2
  1539. SEGDES IPT3
  1540. SEGDES IPT4
  1541. ENDIF
  1542. IF (NBSOF.EQ.2) THEN
  1543. SEGDES IPT5
  1544. SEGDES IPT6
  1545. ENDIF
  1546.  
  1547. c MAUX = MELEFP
  1548. c MELEFP = IMECOTE(1)
  1549. c NGCF=MELEFP.NUM(4,1)
  1550. c WRITE(6,*) 'NGCF= ',NGCF
  1551. c MELEFP = MAUX
  1552.  
  1553. c DO NLS1=1,NSOMM,1
  1554. c MATR1 = IPO2.POINT(NLS1)
  1555. c SEGACT MATR1
  1556. c
  1557. c DO I=1,INDLI.ID(NLS1)
  1558. c DO J = 1,INDLI.ID(NLS1)
  1559. c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J)
  1560. c ENDDO
  1561. c ENDDO
  1562. c ENDDO
  1563. c SEGDES MATR1
  1564.  
  1565. END
  1566.  
  1567.  
  1568.  

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