Télécharger norv4.eso

Retour à la liste

Numérotation des lignes :

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

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